kerrypnx
7/20/2018 - 8:50 AM

复制CC的comment-18-7-20

revise 8-14

Sub CopyccComment()
Dim com As Comment
Dim copyt, copyt1, mainCom, refCom, aimT As String
Dim i, j As Integer
i = 1
j = 1
copyt = ""
copyt1 = ""

Call layout_search_replace.jump_to_reference_section

Dim mainRange, refRange As Range
Set mainRange = ActiveDocument.Range(ActiveDocument.Range.Start, Selection.Range.Start)
Set refRange = ActiveDocument.Range(Selection.Range.Start, ActiveDocument.Range.End)

refRange.Font.ColorIndex = wdRed
For Each com In ActiveDocument.Content.comments
  
  If com.Scope.HighlightColorIndex = wdBrightGreen Then
    
    If com.Scope.Font.ColorIndex <> wdRed Then
    copyt = CStr(i) + ". " + com.Range.Text + " (p. " + CStr(com.Scope.Information(wdActiveEndPageNumber)) + "; L: " + CStr(com.Scope.Information(wdFirstCharacterLineNumber)) + ")" + vbCrLf
    i = i + 1
    mainCom = mainCom + copyt
    
    ElseIf com.Scope.Font.ColorIndex = wdRed Then
    
    copyt1 = CStr(j) + ". " + com.Range.Text + " (No. Ref " + CStr(com.Scope.ListFormat.ListValue) + ")" + vbCrLf
    i = i + 1
    refCom = refCom + copyt1
    End If
    
    
  
    
  End If
 Next


aimT = "In Main Text:" + vbCrLf + mainCom + vbCrLf + "In Reference:" + vbCrLf + refCom
 
With New MSForms.DataObject
    .SetText aimT
    .PutInClipboard
End With
MsgBox "done"
refRange.Font.ColorIndex = wdBlack
End Sub