Solved

Shading Select Table with VBA

Posted on 2011-09-17
2
400 Views
Last Modified: 2012-05-12
I have a document previously generated by a mail merge.  Each page is identical other than the data filled in by the mail merge.  

I would like a VBA routine that reads the table on the top right of each page to determine the color based on the text in that table.   Either Green, Blue, Yellow or White.  Once the color is determined, fill in that table with the color plus the three tables on that page that describe the student's name and their car.   If the color is White, then do nothing on that page.   Pages 1 and 3 have the results I am trying to accomplish.

I have some VBA experience with Excel but I have never written any VBA for WORD.  Any help would be appreciated.

Word 2007 or Word 2010

Thanks,
ProdOps
 EE-Table-Shading.docx
0
Comment
Question by:Jerry Paladino
2 Comments
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 36555938
Assuming the structure is consistent then the following should do it.  You will need to remove the existing highlight color if you change the color constants ... i've deliberately used the  same ones for blue and green.  But included a comment in each case for a potential word constant to make re-use easier ... simply delete the cb constant and the tick to leave the word color constant.

Chris
Sub colorme()
Dim tbl As Table
Dim lngColorBy As Long
Const cbGreen As Long = 5296274
Const cbBlue As Long = 15773696
Const cbYellow As Long = 10092543
    
    For Each tbl In ActiveDocument.Tables
        If InStr(1, tbl.Cell(1, 2).Range.Text, "run group", vbTextCompare) > 0 Then
            If InStr(1, tbl.Cell(1, 2).Range.Text, "green", vbTextCompare) > 0 Then
                lngColorBy = cbGreen 'wdColorLightGreen
            ElseIf InStr(1, tbl.Cell(1, 2).Range.Text, "blue", vbTextCompare) > 0 Then
                lngColorBy = cbBlue ' wdColorPaleBlue
            ElseIf InStr(1, tbl.Cell(1, 2).Range.Text, "yellow", vbTextCompare) > 0 Then
                lngColorBy = cbYellow 'wdColorLightYellow
            Else
                lngColorBy = wdColorAutomatic
            End If
            tbl.Cell(1, 2).Shading.BackgroundPatternColor = lngColorBy
            tbl.Cell(6, 1).Shading.BackgroundPatternColor = lngColorBy
        Else
            tbl.Cell(1, 1).Shading.BackgroundPatternColor = lngColorBy
        End If
    Next

End Sub

Open in new window

0
 
LVL 16

Author Closing Comment

by:Jerry Paladino
ID: 36556340
Chris,

Thank you!  This works great.  It took me a bit to understand how the table cell references were addressed in Word but once I got that it makes perfect sense.

Thank you again!
Jerry
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

There is a feature provided by MS Word that lets you create an Table of Contents for your Word document automatically. To use this feature for other documents there are two steps involved,   1.  Prepare your document for a table of contents (he…
Introduction Authors who set out to write any sort of lengthy piece for online submission—be it a long question or comment on a technical form, an article, or a substantial blog entry—often find it useful to work up a draft in an editor other t…
This video walks the viewer through the process of creating Hyperlinks for the web and other documents. Select the "Insert" tab: Click "Hyperlink":  Type "http://" followed by a web address to reference a website or navigate to a document to ref…
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 …

863 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

Need Help in Real-Time?

Connect with top rated Experts

26 Experts available now in Live!

Get 1:1 Help Now