Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VBA Word. Get the color number of the highlight, of the highlighted text

Posted on 2011-02-14
5
Medium Priority
?
1,334 Views
Last Modified: 2012-05-11
The code below works like a charm. It lists the highlighted text in a String.
What I would like to ask though, is to modify this code a bit so I get the number of the highlight color next to each string catch.  

Option Explicit

Sub CollectHighlights()
    Dim rng As Range
    Dim strText As String
    
    Set rng = ActiveDocument.Range
    Do
        With rng.Find
            .Highlight = True
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            If .Execute Then
                strText = strText & rng.Text & vbCr
                rng.Collapse wdCollapseEnd
                rng.End = ActiveDocument.Range.End
            Else
                Exit Do
            End If
        End With
    Loop While True
    MsgBox strText
End Sub

Open in new window


Thank you with love again as always.

I give full 250 points with an A classification for this.
0
Comment
Question by:New_Alex
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34894697
See below.

Chris
Sub CollectHighlights()
    Dim rng As Range
    Dim strText As String
    
    Set rng = ActiveDocument.Range
    Do
        With rng.Find
            .Highlight = True
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            If .Execute Then
                strText = strText & rng.Text & ", (" & strwdColorIndex(rng.HighlightColorIndex) & ")" & vbCr
                rng.Collapse wdCollapseEnd
                rng.End = ActiveDocument.Range.End
            Else
                Exit Do
            End If
        End With
    Loop While True
    MsgBox strText
End Sub

Function strwdColorIndex(index As Integer) As String
    Select Case index
        Case -1
            strwdColorIndex = "wdByAuthor"
        Case 0
            strwdColorIndex = "wdAuto - No Highlight"
        Case 1
            strwdColorIndex = "Black"
        Case 2
            strwdColorIndex = "Blue"
        Case 3
            strwdColorIndex = "Turquoise"
        Case 4
            strwdColorIndex = "Bright Green"
        Case 5
            strwdColorIndex = "Pink"
        Case 6
            strwdColorIndex = "Red"
        Case 7
            strwdColorIndex = "Yellow"
        Case 8
            strwdColorIndex = "White"
        Case 9
            strwdColorIndex = "Dark Blue"
        Case 10
            strwdColorIndex = "Teal"
        Case 11
            strwdColorIndex = "Green"
        Case 12
            strwdColorIndex = "Violet"
        Case 13
            strwdColorIndex = "Dark Red"
        Case 14
            strwdColorIndex = "Dark Yellow"
        Case 15
            strwdColorIndex = "Grey 50%"
        Case 16
            strwdColorIndex = "Grey 25%"
        Case Else
            strwdColorIndex = "Error!"
    End Select
        
End Function

Open in new window

0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 1000 total points
ID: 34894705
Apologies ... color number is of course simply:

Chris
Sub CollectHighlights()
    Dim rng As Range
    Dim strText As String
    
    Set rng = ActiveDocument.Range
    Do
        With rng.Find
            .Highlight = True
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            If .Execute Then
                strText = strText & rng.Text & ", (" & rng.HighlightColorIndex & ")" & vbCr
                rng.Collapse wdCollapseEnd
                rng.End = ActiveDocument.Range.End
            Else
                Exit Do
            End If
        End With
    Loop While True
    MsgBox strText
End Sub

Open in new window

0
 
LVL 1

Author Comment

by:New_Alex
ID: 34894757
Chris thanks very much,

I love you brother, like always....

Promised points given straight away.....
0
 
LVL 1

Author Closing Comment

by:New_Alex
ID: 34894778
I have modified the code a bit. I inactivated the 2 lines :
 '   rng.Collapse wdCollapseEnd
              '  rng.End = ActiveDocument.Range.End
As they cause some crashes and other problems.
It works better now. (Code below)

[code]Option Explicit

Sub CollectHighlights()
    Dim rng As Range
    Dim strText As String
   
    Set rng = ActiveDocument.Range
    Do
        With rng.Find
            .Highlight = True
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            If .Execute Then
                  strText = strText & "Color Index " & rng.HighlightColorIndex _
                                    & "  : " & rng.Text & vbCr
                '   rng.Collapse wdCollapseEnd
              '  rng.End = ActiveDocument.Range.End
            Else
                Exit Do
            End If
        End With
    Loop While True
    MsgBox strText
End Sub

[/code]

Thanks!!!!
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 34894813
The two lines shouldn't give a problem. They are designed to explicitly search from the end of the current highlight to the end of the document.
0

Featured Post

New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes a serious pitfall that can happen when deleting shapes using VBA.
This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

722 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question