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

x
?
Solved

Assign Color from String in MS Word

Posted on 2013-05-22
4
Medium Priority
?
855 Views
Last Modified: 2013-05-22
Hi All

I have list of colors:
wdColorAqua
wdColorBlue
wd....

and so on.

What I would like to do is apply shading to the paragraph text based on the text string, e.g. if text is wdColorBlue the paragraph should be shaded in that same color.

My code does not work, I'm stuck:
Sub applyColor()
Dim oPar As Paragraph, Color As WdColor, strColor As String

For Each oPar In Selection.Paragraphs
strColor = (Left(oPar.Range.Text, Len(oPar.Range.Text) - 1))
Color = strColor
oPar.Range.Shading.BackgroundPatternColor = Color
Next oPar
End Sub

Open in new window


I get a type mis-match at Color = strColor  :-(

Thanks!
0
Comment
Question by:DrTribos
[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
4 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39186775
Morning/Evening Steve
There are several ways of defining colours in VB(A).

Internally a colour is a Long integer. This can be produced using the RGB function from the individual values or red, blue and green, so

Dim MyColour as long
MyColor = RGB(255,0,0)

defines Red (255)

Also there are several series of enumerated constants:

1. VBA.ColorConstants e.g. vbRed = 255
2. SystemColorConstants e.g.  vbButtonFace = -2147483633 (&H8000000F)
3. wdColor e.g. wdColorRed = 255
4. There is also a set of predefined colours with arbitrary index numbers:
wdColorIndex e.g. wdRed = 6

To convert a string to a colour would require using Select Case
Function GetColour(strColour As String) As Long
    Select Case strColour
        Case "PaleYellow"
            GetColour = &H99FFF
        Case "Red"
            GetColour = wdColorRed
    End Select
End Function

Open in new window


It is possible to copy the text from any of the enumeration list tables in the Help file on to a document and to use find and replace to construct the cases in the body of he Select Case block:
Something like this:
Sub FormatToSelectCase()
    With ActiveDocument.Tables(1)
        .ConvertToText vbTab
    End With
    With ActiveDocument.Range.Find
    .MatchWildcards = True
        .Text = "(wd[A-z0-9]{1,})^t([0-9\-]{1,})^t([A-z0-9 .\-]{1,})^13"
        .Replacement.Text = "Case \1^t'\2^p^tstrText = ""\3""^p"
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Open in new window


Function GetColour(strColour As String) As Long
    Select Case strColour
        Case "wdColorYellow"
            GetColour = wdColorYellow
        Case "wdRed"
            GetColour = wdColorRed
'...
    End Select
End Function
0
 
LVL 15

Author Comment

by:DrTribos
ID: 39186784
Ok!  I do believe you have provided a solution to the problem I have.
0
 
LVL 53

Accepted Solution

by:
Rgonzo1971 earned 2000 total points
ID: 39186806
Hi,

Herewith my solution with splitting the list as text

Sub applyColor()
Dim oPar As Paragraph, Color As WdColor, strColor As String

For Each oPar In Selection.Paragraphs
strColor = (Left(oPar.Range.Text, Len(oPar.Range.Text) - 1))
If strColor <> "" Then
    Color = GetColorNumber(strColor)
oPar.Range.Shading.BackgroundPatternColor = Color
End If
Next oPar
End Sub

Function GetColorNumber(Colr As String) As Long

strColors = "wdColorAqua;13421619/wdColorAutomatic;-16777216/wdColorBlack;0/wdColorBlue;16711680/wdColorBlueGray;10053222/" & _
            "wdColorBrightGreen;65280/wdColorBrown;13209/wdColorDarkBlue;8388608/wdColorDarkGreen;13056/wdColorDarkRed;128/" & _
            "wdColorDarkTeal;6697728/wdColorDarkYellow;32896/wdColorGold;52479/wdColorGray05;15987699/wdColorGray10;15132390/" & _
            "wdColorGray125;14737632/wdColorGray15;14277081/wdColorGray20;13421772/wdColorGray25;12632256/wdColorGray30;11776947/" & _
            "wdColorGray35;10921638/wdColorGray375;10526880/wdColorGray40;10066329/wdColorGray45;9211020/wdColorGray50;8421504/" & _
            "wdColorGray55;7566195/wdColorGray60;6710886/wdColorGray625;6316128/wdColorGray65;5855577/wdColorGray70;5000268/" & _
            "wdColorGray75;4210752/wdColorGray80;3355443/wdColorGray85;2500134/wdColorGray875;2105376/wdColorGray90;1644825/" & _
            "wdColorGray95;789516/wdColorGreen;32768/wdColorIndigo;10040115/wdColorLavender;16751052/wdColorLightBlue;16737843/" & _
            "wdColorLightGreen;13434828/wdColorLightOrange;39423/wdColorLightTurquoise;16777164/wdColorLightYellow;10092543/" & _
            "wdColorLime;52377/wdColorOliveGreen;13107/wdColorOrange;26367/wdColorPaleBlue;16764057/wdColorPink;16711935/" & _
            "wdColorPlum;6697881/wdColorRed;255/wdColorRose;13408767/wdColorSeaGreen;6723891/wdColorSkyBlue;16763904/" & _
            "wdColorTan;10079487/wdColorTeal;8421376/wdColorTurquoise;16776960/wdColorViolet;8388736/wdColorWhite;16777215/wdColorYellow;65535"
            
            
arrColorLines = Split(strColors, "/")

For Each Colour In arrColorLines
    CoulourItem = Split(Colour, ";")
    If CoulourItem(0) = Colr Then
        GetColorNumber = CoulourItem(1)
        Exit Function
    End If
Next

End Function

Open in new window

Regards
0
 
LVL 15

Author Comment

by:DrTribos
ID: 39186814
Hats Off to you Rgonzo!!

Works a treat!
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

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article helps those who get the 0xc004d307 error when trying to rearm (reset the license) Office 2013 in a Virtual Desktop Infrastructure (VDI) and/or those trying to prep the master image for Microsoft Key Management (KMS) activation. (i.e.- C…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

660 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