Solved

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

Posted on 2011-02-14
5
1,303 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 250 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

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing how…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

626 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