在 Word 的单个单元格中创建多个超链接时遇到问题

Question

我有一个脚本，其中单词文档末尾有一个合并表，脚本从第 3 行开始，根据第 2 列和第 3 列查找相同的匹配项，并创建超链接以添加到最后一个表中的单元格 5 .

问题是超链接被其他超链接覆盖，并且我只得到一个超链接，它是该行的最后一个匹配项。

当我使用 ctrl z 检查时，我注意到 -

1. 添加了第一个超链接的文本。
2. 成为超链接。
3. 已添加段落。
4. 添加了第二个超链接的文本。
5. 它没有成为超链接，但这个超链接覆盖了第一个超链接。
6. 已添加段落。
7. 添加了第三个超链接的文本。
8. 但是这个超链接会覆盖第一个超链接，因此在这种情况下，这一行必须有 3 个超链接，但第一个超链接被覆盖，并且超链接的文本保持不变。

这就是我得到的-

匹配表 19 第 16 行 匹配表 4 第 7 行 匹配表 19 第 16 行

这种情况下的输出应该是-

匹配表 3 第 7 行 匹配表 4 第 7 行 匹配表 19 第 16 行

如果有人对此有解决方案，将不胜感激。

Sub FindAndLinkMatches()
    Dim doc As Document
    Dim consolidatedTable As Table
    Dim otherTable As Table
    Dim i As Long, j As Long
    Dim valueCol2 As String
    Dim valueCol3 As String
    Dim tableIdentifier As String
    Dim tableCount As Long
    Dim foundMatch As Boolean
    Dim cellRange As Range
    Dim firstLink As Boolean

    Set doc = ActiveDocument

    Set consolidatedTable = doc.Tables(doc.Tables.Count)

    For i = 3 To consolidatedTable.Rows.Count
        foundMatch = False
        valueCol2 = CleanCellText(consolidatedTable.Cell(i, 2).Range.Text)
        valueCol3 = CleanCellText(consolidatedTable.Cell(i, 3).Range.Text)

        Set cellRange = consolidatedTable.Cell(i, 5).Range
        cellRange.Text = ""

        firstLink = True

        tableCount = 1
        For Each otherTable In doc.Tables
            If otherTable Is consolidatedTable Then GoTo NextTable

            If Trim(CleanCellText(otherTable.Cell(1, 1).Range.Text)) = "Parts Required" Then
                tableIdentifier = "Table" & tableCount

                For j = 2 To otherTable.Rows.Count
                    Dim otherValueCol2 As String
                    Dim otherValueCol3 As String
                    otherValueCol2 = CleanCellText(otherTable.Cell(j, 2).Range.Text)
                    otherValueCol3 = CleanCellText(otherTable.Cell(j, 3).Range.Text)

                    If NormalizeText(valueCol2) = NormalizeText(otherValueCol2) And NormalizeText(valueCol3) = NormalizeText(otherValueCol3) Then
                        otherTable.Rows(j).Range.Bookmarks.Add tableIdentifier & "Row" & j

                        If firstLink = False Then
                            cellRange.InsertAfter vbCr
                        End If

                        cellRange.InsertAfter "Match in " & tableIdentifier & " Row " & j
                        cellRange.Hyperlinks.Add _
                            Anchor:=cellRange.Paragraphs.Last.Range, _
                            Address:="", _
                            SubAddress:=tableIdentifier & "Row" & j, _
                            TextToDisplay:="Match in " & tableIdentifier & " Row " & j
                        
                        firstLink = False
                        foundMatch = True
                    End If
                Next j
                tableCount = tableCount + 1
            End If
NextTable:
        Next otherTable

        If Not foundMatch Then
            cellRange.Text = "No matches found"
        End If
    Next i
End Sub

Function CleanCellText(cellText As String) As String
    cellText = Replace(cellText, Chr(7), "")
    cellText = Replace(cellText, vbCr, "")
    cellText = Replace(cellText, vbLf, "")
    cellText = Replace(cellText, Chr(160), " ")
    CleanCellText = Trim(cellText)
End Function

Function NormalizeText(inputText As String) As String
    inputText = Trim(inputText)
    inputText = Replace(inputText, vbTab, " ")
    inputText = Replace(inputText, "  ", " ")
    inputText = LCase(inputText)
    NormalizeText = inputText
End Function

Answer 1

cellRange.Paragraphs.Last.Range

包括最后一个字符（单元格标记）。使用它作为

Anchor

参数添加超链接时，超链接将应用于单元格内的第一段。

Sub FindAndLinkMatches()
    Dim doc As Document
    Dim consolidatedTable As Table
    Dim otherTable As Table
    Dim i As Long, j As Long
    Dim valueCol2 As String
    Dim valueCol3 As String
    Dim tableIdentifier As String
    Dim tableCount As Long
    Dim foundMatch As Boolean
    Dim cellRange As Range
    Dim firstLink As Boolean
    Set doc = ActiveDocument
    Set consolidatedTable = doc.Tables(doc.Tables.Count)
    For i = 3 To consolidatedTable.Rows.Count
        foundMatch = False
        valueCol2 = CleanCellText(consolidatedTable.Cell(i, 2).Range.Text)
        valueCol3 = CleanCellText(consolidatedTable.Cell(i, 3).Range.Text)
        Set cellRange = consolidatedTable.Cell(i, 5).Range
        cellRange.Text = ""
        firstLink = True
        tableCount = 1
        Dim paraRng As Range  ' **
        For Each otherTable In doc.Tables
            If otherTable Is consolidatedTable Then GoTo NextTable
            If Trim(CleanCellText(otherTable.Cell(1, 1).Range.Text)) = "Parts Required" Then
                tableIdentifier = "Table" & tableCount
                For j = 2 To otherTable.Rows.Count
                    Dim otherValueCol2 As String
                    Dim otherValueCol3 As String
                    otherValueCol2 = CleanCellText(otherTable.Cell(j, 2).Range.Text)
                    otherValueCol3 = CleanCellText(otherTable.Cell(j, 3).Range.Text)
                    If NormalizeText(valueCol2) = NormalizeText(otherValueCol2) And NormalizeText(valueCol3) = NormalizeText(otherValueCol3) Then
                        otherTable.Rows(j).Range.Bookmarks.Add tableIdentifier & "Row" & j
                        If firstLink = False Then
                            cellRange.InsertAfter vbCr
                        End If
                        cellRange.InsertAfter "Match in " & tableIdentifier & " Row " & j
                        ' **
                        Set paraRng = cellRange.Paragraphs.Last.Range
                        paraRng.MoveEnd wdCharacter, -1
                        cellRange.Hyperlinks.Add _
                            Anchor:=paraRng, _
                            Address:="", _
                            SubAddress:=tableIdentifier & "Row" & j, _
                            TextToDisplay:="Match in " & tableIdentifier & " Row " & j
                        ' **
                        firstLink = False
                        foundMatch = True
                    End If
                Next j
                tableCount = tableCount + 1
            End If
NextTable:
        Next otherTable
        If Not foundMatch Then
            cellRange.Text = "No matches found"
        End If
    Next i
End Sub