创建超链接
Sub 创建超链接() ' ' 创建超链接 宏 ' 为所选择的表格的第一列的cmdlet命令创建对应的超链接(前提是已经存在对应的命令说明内容) ' 只处理第一个表格 ' Application.ScreenUpdating = False '关闭同步调整更新 Dim my_table As Table If (0 = Selection.Tables.Count) Then '所选内容没有表格存在 MsgBox ("所选内容没有表格存在") Exit Sub End If Set my_table = Selection.Tables(1) Dim table_Rows As Long table_Rows = my_table.Rows.Count Dim row_index As Long row_index = 1 Dim regex As Object '声明 Set regex = CreateObject("VBScript.RegExp") '创建正则对象 With regex: .Pattern = "^[\w-]+" '设置正则表达式 End With Do Dim temp_str As String temp_str = my_table.Cell(row_index, 1).Range.Text Dim my_Matches As Object Set my_Matches = regex.Execute(temp_str) If (0 < my_Matches.Count) Then Result = select_range("cmdlet 命令", "Server 2016 core") '选择查询范围,否则会因为之前选择了表格导致找不到 Selection.Find.ClearFormatting '清除之前的查询格式、选项 '设置现在的查询格式 With Selection.Find .Style = ActiveDocument.Styles("标题 2") .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False '是否区分大小写 .MatchWholeWord = False .MatchByte = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False .MatchWholeWord = True '是否全字匹配 .MatchPrefix = True '匹配前缀 .MatchSuffix = True '匹配后缀 .Text = my_Matches(0).Value If (.Execute) Then Selection.Copy '要定位到表格中 my_table.Cell(row_index, 1).Select 'Selection.Delete CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:01")) '必须加上延时,否则会报运行时错误4198 Selection.PasteSpecial Link:=True, DataType:=wdPasteHyperlink End If End With End If row_index = row_index + 1 Loop While row_index <= table_Rows Application.ScreenUpdating = True '开启同步调整更新 End Sub
【推荐】国内首个AI IDE,深度理解中文开发场景,立即下载体验Trae
【推荐】编程新体验,更懂你的AI,立即体验豆包MarsCode编程助手
【推荐】抖音旗下AI助手豆包,你的智能百科全书,全免费不限次数
【推荐】轻量又高性能的 SSH 工具 IShell:AI 加持,快人一步
· DeepSeek 开源周回顾「GitHub 热点速览」
· 物流快递公司核心技术能力-地址解析分单基础技术分享
· .NET 10首个预览版发布:重大改进与新特性概览!
· AI与.NET技术实操系列(二):开始使用ML.NET
· 单线程的Redis速度为什么快?
2019-05-26 horizon配置