Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub ExtractHighlightedTextsInSameColor()
- Dim objDoc As Document, objDocAdd As Document
- Dim objRange As Range
- Dim strFindColor As String
- Dim highliteColor As Variant
- highliteColor = Array(wdYellow, wdTeal)
- Set objDoc = ActiveDocument
- Set objDocAdd = Documents.Add
- objDoc.Activate
- For i = LBound(highliteColor) To UBound(highliteColor)
- With Selection
- .HomeKey Unit:=wdStory
- With Selection.Find
- .Highlight = True
- Do While .Execute
- If Selection.Range.HighlightColorIndex = highliteColor(i) Then
- Set objRange = Selection.Range
- objDocAdd.Range.InsertAfter objRange & vbCr
- Selection.Collapse wdCollapseEnd
- End If
- Loop
- End With
- End With
- Next
- End Sub
- Sub HighlightedColor()
- Dim objDoc As Document, objDocAdd As Document
- Dim objRange As Range
- Dim highliteColor As Variant
- highliteColor = Array(wdYellow, wdTeal, wdPink)
- Set objDoc = ActiveDocument
- Set objDocAdd = Documents.Add
- objDoc.Activate
- For i = LBound(highliteColor) To UBound(highliteColor)
- With Selection
- .HomeKey Unit:=wdStory
- With Selection.Find
- .Highlight = True
- Do While .Execute
- If Selection.Range.HighlightColorIndex = highliteColor(i) Then
- Set objRange = Selection.Range.FormattedText
- objRange.Collapse wdCollapseEnd
- objDocAdd.Content.FormattedText = objRange
- End If
- Loop
- End With
- End With
- Next
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement