Oscar Sun

                  Sub 色塊_把色塊所在段落複製到新文件()
Dim d As Document, p As Paragraph, a, dnew As Document
Set d = ActiveDocument
Set dnew = Documents.Add
For Each p In d.Paragraphs
    If p.Range.HighlightColorIndex <> 0 Then
        p.Range.Copy
        dnew.Paragraphs.Add
        dnew.Paragraphs(dnew.Paragraphs.Count).Range.Paste
    End If
Next
End Sub