word vba 在一个word文档中cha询关键词所在的页面

ClownSir

word vba   在一个word文档中cha询关键词所在的页面

例如 关键词  在  第一页 第五页  第六页……


则返回对应的   第一页 第五页  第六页……

目前，先出的来的，只能cha询到关键词第一次出现的页数

cha询到后，程序就结束 不执行了

zhongzutao

zhongzutao 发表于 2023-5-24 14:42
Sub search_keyword_dialog()
    Dim keyword As String
    Dim total_pages As Integer

这下好了   page是页码，其余的行数你可以不管他

zhongzutao

Sub FindKeywordPages()
    Dim pattern As String
    Dim pageNums As String
    Dim doc As Document
    Set doc = ActiveDocument
   
    ' 获取用户输入的关键词
    pattern = InputBox("请输入要查找的关键词：")
   
    If pattern <> "" Then
        With doc.Content.Find
            .ClearFormatting
            .Text = pattern
            .MatchWholeWord = True
            .Wrap = wdFindStop
            
            ' 查找关键词所在页码
            While .Execute
                pageNums = pageNums & CStr(doc.Application.Selection.Range.Information(wdActiveEndPageNumber)) & ", "
            Wend
        End With
        
        ' 显示关键词所在页码
        If pageNums <> "" Then
            MsgBox "关键词“" & pattern & "”出现在以下页面：" & Left(pageNums, Len(pageNums) - 2), vbInformation, "查找结果"
        Else
            MsgBox "未找到关键词“" & pattern & "”", vbExclamation, "查找结果"
        End If
    End If
End Sub

ClownSir

zhongzutao 发表于 2023-5-24 14:06
Sub FindKeywordPages()
    Dim pattern As String
    Dim pageNums As String

  显示这样

zhongzutao

ClownSir 发表于 2023-5-24 14:12
显示这样

多个页面忘记移动页面了

zhongzutao

Sub search_keyword_dialog()
    Dim keyword As String
    Dim total_pages As Integer
    Dim page_num As Integer
    Dim line_num As Integer
    Dim line As String
    Dim result As String

    ' 弹出输入框让用户输入关键词
    keyword = InputBox("请输入要搜索的关键词：")

    ' 获取文档总页数
    total_pages = ActiveDocument.ComputeStatistics(wdStatisticPages)

    ' 循环每一页
    For page_num = 1 To total_pages
        ' 跳转到当前页
        ActiveDocument.Bookmarks("\Page").Range.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=page_num

        ' 循环每一行
        For line_num = 1 To ActiveDocument.Bookmarks("\Page").Range.ComputeStatistics(wdStatisticLines)
            ' 获取当前行文本
            line = ActiveDocument.Bookmarks("\Page").Range.Paragraphs(line_num).Range.Text

            ' 如果关键字出现在该行中
            If InStr(line, keyword) > 0 Then
                ' 记录页码和行号
                result = result & "Keyword '" & keyword & "' found on page " & page_num & ", line " & line_num & vbCrLf
                ' 跳到下一页的第一行
                Exit For
            End If
        Next line_num
    Next page_num

    ' 显示搜索结果
    If result <> "" Then
        MsgBox result
    Else
        MsgBox "未找到关键词'" & keyword & "'"
    End If
End Sub

lisher

扔机qi人里就出来了

[Visual Basic] 纯文本查看 复制代码

Sub FindKeyword()
    Dim keyword As String
    Dim doc As Document
    Dim rng As Range
    Dim result As String

    '输入要查找的关键字
    keyword = InputBox("请输入要查找的关键字：")

    '如果输入了关键字则继续执行
    If keyword <> "" Then
        '获取当前文档
        Set doc = ActiveDocument
        '设置查找范围为整个文档
        Set rng = doc.Range
        '查找关键字
        With rng.Find
            .Text = keyword
            .MatchWholeWord = True '匹配整个单词
            .Wrap = wdFindStop '查找到文档末尾停止
            Do While .Execute '循环查找关键字
                '计算所在页数
                result = result & rng.Information(wdActiveEndPageNumber) & ", "
            Loop
            '如果找到了关键字
            If Len(result) > 0 Then
                '去掉最后的逗号和空格
                result = Left(result, Len(result) - 2)
                '显示结果
                MsgBox "关键字“" & keyword & "”所在页数为：" & result
            Else '如果未找到关键字
                MsgBox "未找到关键字“" & keyword & "”"
            End If
        End With
    End If
End Sub