Question

我一直在浏览论坛一段时间，试图找到问题的答案，而且我是密集的还是没有得到回答，所以我在这里。< / p>

长话短说，我的工作涉及撰写列出建筑缺陷的文字文件，并提供所述缺陷图像的超链接。可见超链接文本始终遵循相同的格式：＆＃39; [网站缩写] [（图像编号）]。JPG＆＃39;。例如，如果我们查看“行政大楼”，我们的图片将被命名为“AB（1）.JPG＆＃39; AB＆B; AB（2）.JPG＆＃39;等等，经常进入数百或数千中。在word文档中，它们被引用为＆＃39; AB1＆＃39;＆＃39; AB2＆＃39;等

目前，我有一个宏，允许我在选择文本后自动创建超链接，但我正在尝试创建一个可以查看文档的宏（或者更好的是，突出显示的选项）并为任何一次以网站缩写开头的文本指定超链接。

我目前对大规模超链接宏的尝试令人沮丧地接近，但有一个主要错误：虽然它会正确地超链接它找到的第一个图像名称，但所有后续图像都与链接中包含的下两个字符链接。例如，如果一句话说'＃34;这是不正确的（AB33），但这是正确的（AB34）＆＃39;，我的宏将超链接文本＆＃39; AB34＆＃39; （这是正确的）和＆＃39; AB33）＆＃39; （这是不正确的。）

这是我迄今为止一直在使用的宏（请注意，＆＃39; XXXX ...＆＃39;行之间的文字是我的同事更改链接目的地的基本说明需要）

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

Word宏到批量超链接可变长度字符串

1 个答案: