在VBA WORD

Question

我有一个Word文档，我想搜索一个文本，如果找到它执行某个操作，但我得到runtime error 5854说明我的搜索字符串太长。自昨天以来，我一直在寻找和尝试不同的东西，但不能提出一个有效的代码。 如果你们中的一些人可以帮助我，我将感激不尽。

Sub FindTextAndHighlight()
    Dim srchTxt As Variant
    srchTxt = "Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions of Lorem Ipsum. "        
    With ActiveDocument.Content.Find
     .Text = srchTxt
     .Forward = True
     .Execute
        If .Found = True Then
           .Font.ColorIndex = wdRed
           .Wrap = wdFindStop
           .Parent.Bold = True
        End If
    End With

End Sub

Answer 1

您可以使用IntStr函数查找开头，然后将srchTxt字符串长度添加到其中以查找文档中的范围。

如果找不到srchTxt，我已经包含了某种错误句柄。

Option Explicit

Sub FindTextAndHighlight()

    Dim FoundStart As Long
    Dim FoundEnd As Long
    Dim DocContent As String
    Dim srchTxt As String
    Dim srchTxtLength As Long
    Dim FoundRange As Range

    srchTxt = "Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions of Lorem Ipsum. "
    srchTxtLength = Len(srchTxt)

    DocContent = ActiveDocument.Content

    ' using -1 to include the first character of the srchTxr found
    FoundStart = InStr(1, DocContent, srchTxt, vbTextCompare) - 1

    If FoundStart > 0 Then
        FoundEnd = FoundStart + srchTxtLength

        Set FoundRange = ActiveDocument.Range(FoundStart, FoundStart + srchTxtLength)

        If Not FoundRange Is Nothing Then
            With FoundRange
                   .Font.ColorIndex = wdRed
                   .Font.Bold = True
            End With
        End If
    Else

        MsgBox "Seach String: " & vbCr & vbCr & srchTxt & vbCr & vbCr & "Not Found!"

    End If
End Sub

将搜索作为循环进行。

Option Explicit

Sub FindTextAndHighlight()

    Dim FoundStart As Long
    Dim FoundEnd As Long
    Dim DocContentSearchRange As Range
    Dim srchTxt As String
    Dim srchTxtLength As Long
    Dim FoundRange As Range

    srchTxtShort = "Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. "
    srchTxtLong = "Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions of Lorem Ipsum. "
    srchTxtLength = Len(srchTxtLong)

    Set DocContentSearchRange = ActiveDocument.Range
    Set FoundRange = ActiveDocument.Range

    With DocContentSearchRange.Find
        .Text = srchTxtShort
        .MatchCase = True
    End With

    Do While DocContentSearchRange.Find.Execute

        If DocContentSearchRange.Find.Found Then

            FoundRange.Start = DocContentSearchRange.Start
            FoundRange.End = FoundRange.Start + srchTxtLength
            FoundRange.Select

            If InStr(1, FoundRange.Text, srchTxtLong, vbTextCompare) > 0 Then

            With FoundRange
                   .Font.ColorIndex = wdRed
                   .Font.Bold = True
            End With

            Else

                MsgBox "Seach String: " & vbCr & vbCr & srchTxtLong & vbCr & vbCr & "Not Found!"

            End If

            DocContentSearchRange.Start = FoundRange.End

        End If   'If  DocContentSearchRange.Find.Found
    Loop
End Sub