如何创建MS Word宏以检查＆＃34;粗体＆＃34; +＆＃34;没有Keep With Next＆＃34;段落并为每个添加评论

Question

我试图创建一个宏来检查＆＃34;粗体＆＃34; +＆＃34;没有Keep With Next＆＃34;段落并通过在word应用程序中使用宏记录功能为每个段落添加注释。但它对我不起作用。

我需要为以下条件创建一个宏。

1. 搜索所有粗体段落+不与下一个保持一致。
2. 然后为每个加粗+添加注释，而不保留下一个。 （例如：检查Keep With Next）

我该怎么做。

----------编辑----------

为了更清晰，请参阅此图片：



我已经尝试过了。

Sub KWN_Checker()

Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
With Selection.Find.ParagraphFormat
    .KeepWithNext = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "^p"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
End With
Selection.Find.Execute
Selection.Comments.Add Range:=Selection.Range
Selection.TypeText Text:="Check"
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
With Selection.Find.ParagraphFormat
    .KeepWithNext = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "^p"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True

End With
Selection.TypeText Text:=" Keep With Next"
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
With Selection.Find.ParagraphFormat
    .KeepWithNext = False
End With
Selection.Find.Execute
End Sub

Answer 1

这可能是一种更有效的方法，但这可以做你想要的：

   Option Explicit

Sub FncCheckBold()

    Const message As String = "Check Keep With Next"
    Const styleMask As String = "Bold + KWN"
    Dim doc As Document
    Dim paragraphCount As Integer
    Dim i As Integer
    Dim currentStyle As String

    Set doc = ActiveDocument
    paragraphCount = doc.Paragraphs.Count

    Do While i < paragraphCount

        i = i + 1

        If doc.Paragraphs(i).Range.Bold = True Then

            currentStyle = doc.Paragraphs(i).Range.Style

            If Left(currentStyle, Len(styleMask)) <> styleMask Then

                doc.Paragraphs(i).Range.Select
                Selection.Comments.Add Range:=Selection.Range
                Selection.TypeText Text:=message

            End If

        End If

    Loop

    Set doc = Nothing

End Sub