Solved

Shading Select Table with VBA

Posted on 2011-09-17
2
402 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

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

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

I'm writing to share my clumsy experience in using this elegant tool so you can avoid every stupid mistake I made. (I leave it to the authorities to decide if this deserves a place in the Knowledge archives.)  Now that I am on the other side of my l…
Preface: When I started this series, I used the term CommandBars because that is the Office Object class that it discusses. Unfortunately, when Microsoft introduced Office 2007, they replaced the standard Commandbar menus with "The Ribbon" and rem…
This video walks the viewer through the process of creating an MLA formatted document, as well as a bibliography with citations.
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 …

785 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