【问题标题】:vbscript: replace text in activedocument with hyperlinkvbscript:用超链接替换活动文档中的文本
【发布时间】:2013-02-15 13:05:46
【问题描述】:

刚开始一份新工作,我必须阅读前任留下的大量文件。它们是包含数百项专利信息的 MS Word 文件。我不想在在线表格中复制/粘贴每个专利号,而是想用可点击的超链接替换所有专利号。我想这应该使用 vbscript 来完成(我不习惯使用 MS Office)。

到目前为止:

<obsolete>

这对我不起作用: 1. 我(可能)需要添加一些东西来循环 ActiveDocument 2. 替换函数可能需要一个字符串而不是一个对象作为参数 - vbscript 中有 __toString() 吗?

谢谢!

更新: 我有这个部分工作(正则表达式和查找匹配项) - 现在只要我能正确获得 hyperlink.add-method 的锚点......

Sub HyperlinkPatentNumbers()
'
' HyperlinkPatentNumbers Macro
'

Dim objRegExp, Matches, match, myRange

Set myRange = ActiveDocument.Content

Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
    .Global = True
    .IgnoreCase = False
    .Pattern = "(WO|EP|US)([0-9]*)(A1|A2|B1|B2)"
End With

Set Matches = objRegExp.Execute(myRange)

If Matches.Count >= 1 Then
    For Each match In Matches
        ActiveDocument.Hyperlinks.Add Anchor:=objRegExp.match, Address:="http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=$1&NR=$2&KC=$3"
    Next
End If

Set Matches = Nothing
Set objRegExp = Nothing

End Sub

【问题讨论】:

    标签: regex vbscript hyperlink


    【解决方案1】:

    这是 VBA 还是 VBScript?在 VBScript 中,你不能声明像 Dim newText As hyperLink 这样的类型,但每个变量都是一个变体,所以:Dim newText 仅此而已。

    objRegEx.Replace 返回带有替换的字符串,需要传入两个参数:原始字符串和要替换模式的文本:

    Set objRegEx = CreateObject("VBScript.RegExp")
    objRegEx.Global = True
    objRegEx.IgnoreCase = False
    objRegEx.Pattern = "^(WO|EP|US)([0-9]*)(A1|A2|B1|B2)$"
    
    ' assuming plainText contains the text you want to create the hyperlink for
    strName = objRegEx.Replace(plainText, "$1$2$3")
    strAddress = objRegex.Replace(plainText, "http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=$1&NR=$2&KC=$3"
    

    现在您可以使用strNamestrAddress 创建超链接。
    专业提示:您可以使用objRegEx.Test(plainText) 查看正则表达式是否匹配任何内容,以便及早处理错误。

    【讨论】:

    • THX - 它没有开箱即用,但我进一步搜索,我已经更新了我的第一篇文章。你能看一下吗?
    • VBScript 无法处理像Anchor:=foo 这样的命名参数。尝试使用参数位于固定位置的本机版本:ActiveDocument.Hyperlinks.Add Anchor, Address, SubAddress, ScreenTip, TextToDisplay
    • 仅供参考:If Matches.Count &gt;= 1 Then 是不需要的,因为如果没有匹配项,执行将直接通过For Each match In Matches 而不处理内部语句。
    【解决方案2】:

    问题解决了:

    Sub addHyperlinkToNumbers()
    
    Dim objRegExp As Object
    Dim matchRange As Range
    Dim Matches
    Dim match
    
    Set objRegExp = CreateObject("VBScript.RegExp")
    
    With objRegExp
        .Global = True
        .IgnoreCase = False
        .Pattern = "(WO|EP|US|FR|DE|GB|NL)([0-9]+)(A1|A2|A3|A4|B1|B2|B3|B4)"
    End With
    
    Set Matches = objRegExp.Execute(ActiveDocument.Content)
    
    For Each match In Matches
        'This doesn't work, because of the WYSIWYG-model of MS Word:
        'Set matchRange = ActiveDocument.Range(match.FirstIndex, match.FirstIndex + Len(match.Value))
    
        Set matchRange = ActiveDocument.Content
        With matchRange.Find
            .Text = match.Value
            .MatchWholeWord = True
            .MatchCase = True
            .Wrap = wdFindStop
            .Execute
        End With
    
        ActiveDocument.Hyperlinks.Add Anchor:=matchRange, _
            Address:="http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=" _
            & match.Submatches(0) & "&NR=" & match.Submatches(1) & "&KC=" & match.Submatches(2)
    
    Next
    
    MsgBox "Hyperlink added to " & Matches.Count & " patent numbers"
    
    Set objRegExp = Nothing
    Set matchRange = Nothing
    Set Matches = Nothing
    Set match = Nothing
    
    End Sub
    

    【讨论】:

    • 事实上,我不得不在选择正则表达式作为范围的部分解决一个小错误。我将更新我的答案,使其成为完整的工作代码。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2022-12-05
    • 2018-03-22
    • 2019-10-20
    • 1970-01-01
    • 2017-10-15
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多