vbscript：用超链接替换activedocument中的文本 [英] vbscript: replace text in activedocument with hyperlink

问题描述

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

Starting out at a new job and I have to go through a whole lot of documents that my predecessor left. They are MS Word-files that contain information on several hundreds of patents. Instead of copy/pasting every single patent-number in an online form, I would like to replace all patent-numbers with a clickable hyperlink. I guess this should be done with vbscript (I'm not used to working with MS Office).

我到目前为止：

<obsolete>

这对我不起作用：
1.我（可能）需要添加一些东西循环遍历ActiveDocument
2.替换函数可能需要一个字符串而不是参数的对象 - 在vbscript中是否有__toString（）？

This is not working for me: 1. I (probably) need to add something to loop through the ActiveDocument 2. The replace-function probably needs a string and not an object for a parameter - is there a __toString() in vbscript?

THX！

更新：
我有部分工作（正则表达式和查找匹配项） - 现在只要我能获得超链接的锚点。添加方法权...

UPDATE: I have this partially working (regex and finding matches) - now if only I could get the anchor for the hyperlink.add-method right...

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

推荐答案

问题解决了：

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

这篇关于vbscript：用超链接替换activedocument中的文本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！