Word宏彌撒超鏈接的可變長度字符串

Question

我一直期待通過論壇，而現在試圖找到一個答案，我的問題，並且或者我是密集或尚未回答，所以我在這裏。

長話短說，我的工作涉及編寫了該名單的建設赤字Word文檔，並提供超鏈接，說赤字的圖像。可見的超鏈接文本總是遵循相同的格式：'[網站縮寫] [（圖片編號）] .JPG'。例如，如果我們正在查看'行政大樓'，我們的圖像將被命名爲'AB（1）.JPG'，'AB（2）.JPG'等等，通常爲數百或數千。在word文檔中，它們被引用爲'AB1'，'AB2'等。

目前，我有一個宏，允許我在選擇文本後自動創建一個超鏈接，但我試圖創建一個將查看文檔（或更好的是突出顯示的選擇）的宏，並將超鏈接分配給以站點縮寫開頭的任何文本。

我目前在一個大規模超鏈接宏的嘗試令人沮喪地接近，但有一個主要錯誤：雖然它會正確地超鏈接它找到的第一個圖像名稱，所有後續的圖像都鏈接到鏈接中包含的下兩個字符。例如，如果一個句子要說「這是不正確的（AB33），但這是正確的（AB34）'，我的宏將超文本'AB34'（這是正確的）和'AB33）'（這是不正確的）。

這是我一直在工作，因此到目前爲止，宏（注意，「XXXX ......」字裏行間的文字是基本指令爲需要我的同事改變鏈接目的地）

Option Explicit 


    Sub Mass_Hyperlink_v_1_1() 
'incomplete: selects incorrect text after first link 

Dim fileName As String 
Dim filePath As String 
Dim rng As Range 
Dim tag As String 
Dim FileType As String 
Dim folder As String 
Dim space As String 
Dim start As String 
Dim report_type As String 
Dim temp As String 

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 
'Do not touch anything above this line 

    'Answer the following for the current document. Leave all quotations. 

    report_type = "CL"   'CL = Checklist 
           'SR = Site Report 

    folder = "Doors"   'The name of the folder you are linking images from 
           'Must match folder exactly 

    tag = "FS"     'Put file prefix here (ex. if link says "AB123", put "AB") 

    space = "No"    'Does the image file have a space in it? (ex. if file name is "AB (23)", put "yes") 

    FileType = ".JPG"   'make sure filetype extensions match 

'Do not touch anything below this line 
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 

If space = "Yes" Then 
    start = "%20(" 
    Else: start = "(" 
End If 

If report_type = "CL" Then 
    folder = "..\Images\" & folder 
    Else: folder = folder 
End If 

If report_type = "SR" Then 
    folder = "Images\" & folder 
    Else: folder = folder 
End If 

Set rng = ActiveDocument.Range 

With rng.find 
.MatchWildcards = True 
    Do While .Execute(findText:=tag, Forward:=False) = True 
     rng.MoveStartUntil (tag) 
     rng.Select 
     Selection.Extend 
     Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend 


     'I believe the issue is created here 

     Selection.start = Selection.start + Len(tag) 

     ActiveDocument.Range(Selection.start - Len(tag), Selection.start).Delete 

    fileName = Selection.Text 

    filePath = folder & "\" & tag & start & fileName & ")" & FileType 

    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, address:= _ 
     filePath, SubAddress:="", ScreenTip:="", TextToDisplay:= _ 
     tag & Selection.Text 

    rng.Collapse wdCollapseStart 


    Loop 
End With 

End Sub 

如果我已經解釋了這個可怕的錯誤或不能提供足夠的信息，請讓我知道，我會試着更清楚。如果有是，我只是過於密集已經找到了有用的資源，請讓我知道！謝謝！

編輯：如果有人知道如何選擇以標籤開頭的單詞，而不是帶有標籤文字的單詞，我會非常感激！

Answer 1

如果你想匹配一個固定的標籤及隨後的數字可變數目：

Sub Tester() 
    TagMatches ActiveDocument, "AB" 
End Sub 


Sub TagMatches(doc As Document, tag As String) 
    Dim rng 

    Set rng = doc.Range 

    With rng.Find 
     .Text = tag & "[0-9]{1,}" 
     .Forward = True 
     .MatchWildcards = True 
     Do While .Execute 
      Debug.Print rng.Text 
     Loop 
    End With 

End Sub 

參見：http://word.mvps.org/faqs/general/usingwildcards.htm