宏在Word文档中的选定文本中插入关键字的注释?

时间:2016-08-15 15:55:29

标签: vba ms-word macros word-vba

我是VBA的新手,非常感谢对问题的一些帮助。

我有很长的Word文档,我需要将标准注释应用于同一组关键字,但仅限于文档的选定部分。以下宏用于查找关键字并应用注释(来自此处的问题https://superuser.com/questions/547710/macro-to-insert-comment-bubbles-in-microsoft-word):

Sub label_items()
'
' label_items Macro
'
'
Do While Selection.Find.Execute("keyword1") = True
    ActiveDocument.Comments.Add range:=Selection.range, Text:="comment for keyword 1"
Loop

End Sub

这两项修改是:

1)仅将注释应用于用户选择的文本,而不是整个文档。我尝试了一个" With Selection.Range.Find"方法,但我不认为评论可以这样添加(??)

2)在所选文本中为20多个关键字重复此操作。关键字不是完全标准的,名称如P_1HAI10,P_1HAI20,P_2HAI60,P_HFS10等。

编辑:我尝试合并来自类似问题的代码(Word VBA: finding a set of words and inserting predefined commentsWord macro, storing the current selection (VBA)),但我目前的尝试(下方)仅针对第一个关键字和评论运行,并在整个文档上运行,而不是只是我突出显示/选中的文字。

Sub label_items()
'
' label_items Macro
'
Dim selbkup As range
Set selbkup = ActiveDocument.range(Selection.range.Start, Selection.range.End)

Set range = selbkup

Do While range.Find.Execute("keyword 1") = True
    ActiveDocument.Comments.Add range, "comment for keyword 1"
Loop

Set range = selbkup

Do While range.Find.Execute("keyword 2") = True
    ActiveDocument.Comments.Add range, "comment for keyword 2"
Loop

'I would repeat this process for all of my keywords

End Sub

我已经梳理过以前的问题和办公室开发中心,我被困住了。非常感谢任何帮助/指导!

1 个答案:

答案 0 :(得分:1)

这是一个添加循环和Finding您正在寻找的下一个关键字的方法。下面的代码示例中有一些建议,因此请根据需要进行调整以满足您的要求。

Option Explicit

Sub label_items()
    Dim myDoc As Document
    Dim targetRange As Range
    Set myDoc = ActiveDocument
    Set targetRange = Selection.Range

    '--- drop a bookmark to return the cursor to it's original location
    Const RETURN_BM = "OrigCursorLoc"
    myDoc.Bookmarks.Add Name:=RETURN_BM, Range:=Selection.Range

    '--- if nothing is selected, then search the whole document
    If Selection.Start = Selection.End Then
        Selection.Start = 0
        targetRange.Start = 0
        targetRange.End = myDoc.Range.End
    End If

    '--- build list of keywords to search
    Dim keywords() As String
    keywords = Split("SMS,HTTP,SMTP", ",", , vbTextCompare)

    '--- search for all keywords within the user selected range
    Dim i As Long
    For i = 0 To UBound(keywords)
        '--- set the cursor back to the beginning of the
        '    originally selected range
        Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM
        Do
            With Selection.Find
                .Forward = True
                .Wrap = wdFindStop
                .Text = keywords(i)
                .Execute

                If .Found Then
                    If (Selection.Start < targetRange.End) Then
                        Selection.Comments.Add Selection.Range, _
                                               Text:="Found the " & keywords(i) & " keyword"
                    Else
                        Exit Do
                    End If
                Else
                    Exit Do
                End If
            End With
        Loop
    Next i

    '--- set the cursor back to the beginning of the
    '    originally selected range
    Selection.GoTo What:=wdGoToBookmark, Name:=RETURN_BM

End Sub