Private Sub CommandButton1_Click()

    Dim i As Integer
    

    Set allComments = ActiveDocument.Comments

    If allComments.Count = 0 Then
        MsgBox "本文档没有批注。"
    Else
        Selection.GoTo What:=wdGoToBookmark, Name:="批注插入点"
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.EndKey Unit:=wdStory, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.TypeParagraph
        Selection.TypeParagraph

        For i = 1 To ActiveDocument.Comments.Count
            Selection.TypeText (i & "、" & ActiveDocument.Comments(i).Author
& "于 " & ActiveDocument.Comments(i).Date & "，针对：")
            Selection.TypeParagraph
            Selection.TypeParagraph

            
            ActiveDocument.Comments(i).Scope.Copy
            Selection.Paste
            Selection.TypeParagraph
            Selection.TypeParagraph
            
            Selection.TypeText ("作了批注：")
            Selection.TypeParagraph
            Selection.TypeParagraph

          
            ActiveDocument.Comments(i).Range.Copy
            Selection.Paste
            Selection.TypeParagraph
            Selection.TypeParagraph

        Next

        Selection.GoTo What:=wdGoToBookmark, Name:="批注插入点"
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If

End Sub


【 在 unchained (琉璃光) 的大作中提到: 】
: 谢谢！现在可以运行，成功了
: 但是在自己的文档里怎么使用？直接复制过去，点击按钮没有反应
: 如果多次点击按钮，批注就被清空了
: ...................
--
FROM 58.23.247.*
附件(29.9KB) 提取批注.docm