Word VBA Find Table Text Shading Colour and replace with another

QA_Compliance_Advisor · #1 09-19-2014, 02:46 AM

I need to be able to find and replace Table Text Shading colour which maybe in more than one row and column.

Does anyone have knowledge how to do this.

It will also have to be able to work with the rest of a code that has been written to be able to to multuple word docuements (code attached).

QA_Compliance_Advisor · #2 09-19-2014, 03:35 AM

I have this code which seems to only change the first cell.

Code:

Function ChangeLogo(wdDoc)
Dim ocell As Cell
For Each ocell In wdDoc.Range.Cells
  With ocell.Shading
    If .BackgroundPatternColor = RGB(51, 51, 153) Then
    .BackgroundPatternColor = RGB(12, 71, 157)
    .ForegroundPatternColor = wdColorWhite
    End If
  End With
Next
End Function

gmayor · #3 09-19-2014, 04:38 AM

You need to identify the table the cells are in e.g.

Code:

Function ChangeLogo(wdDoc)
Dim oTable As Table
Dim ocell As Cell
    Set oTable = wdDoc.Tables(1)
    For Each ocell In oTable.Range.Cells
        With ocell.Shading
            If .BackgroundPatternColor = RGB(51, 51, 153) Then
                .BackgroundPatternColor = RGB(12, 71, 157)
                .ForegroundPatternColor = wdColorWhite
            End If
        End With
    Next ocell
End Function

QA_Compliance_Advisor · #4 09-19-2014, 04:42 AM

Quote:

Originally Posted by gmayor

You need to identify the table the cells are in e.g.

Code:

Function ChangeLogo(wdDoc)
Dim oTable As Table
Dim ocell As Cell
    Set oTable = wdDoc.Tables(1)
    For Each ocell In oTable.Range.Cells
        With ocell.Shading
            If .BackgroundPatternColor = RGB(51, 51, 153) Then
                .BackgroundPatternColor = RGB(12, 71, 157)
                .ForegroundPatternColor = wdColorWhite
            End If
        End With
    Next ocell
End Function

I did it this way? any thoughts?

Code:

Function ChangeLogo(wdDoc)
Dim oCell As Cell, oTbl As Table, oRow As Row, oRng As Range
Dim i As Long
For Each oTbl In wdDoc.Tables
  For Each oRow In oTbl.Rows
    For Each oCell In oRow.Cells
      If oCell.Shading.BackgroundPatternColor = RGB(51, 51, 153) Then
      oCell.Shading.BackgroundPatternColor = RGB(12, 71, 157)
      End If
    Next
   Next
 Next
  
End Function

having troubles changing the text colour in the cell. Any suggestions?

gmayor · #5 09-19-2014, 05:00 AM

If the table is in the body of the document, and if the background colour is as you indicate (Use ColorCop to sample the colour if necessary), then that should work. It changes the colour from a dark blue to a slightly lighter blue.

If the table is not in the body then you will have to tell the macro in which story range to look for the table(s).

QA_Compliance_Advisor · #6 09-19-2014, 05:21 AM

Quote:

Originally Posted by gmayor

If the table is in the body of the document, and if the background colour is as you indicate (Use ColorCop to sample the colour if necessary), then that should work. It changes the colour from a dark blue to a slightly lighter blue.

If the table is not in the body then you will have to tell the macro in which story range to look for the table(s).

all this is in te body text, none are in headers or footers or anywhere else.

and still the text colour won't change.

QA_Compliance_Advisor · #7 09-19-2014, 05:42 AM

Quote:

Originally Posted by QA_Compliance_Advisor

I did it this way? any thoughts?

Code:

Function ChangeLogo(wdDoc)
Dim oCell As Cell, oTbl As Table, oRow As Row, oRng As Range
Dim i As Long
For Each oTbl In wdDoc.Tables
  For Each oRow In oTbl.Rows
    For Each oCell In oRow.Cells
      If oCell.Shading.BackgroundPatternColor = RGB(51, 51, 153) Then
      oCell.Shading.BackgroundPatternColor = RGB(12, 71, 157)
      End If
    Next
   Next
 Next
 
End Function

having troubles changing the text colour in the cell. Any suggestions?

how would I deal with merged cells?

gmaxey · #8 09-19-2014, 05:48 AM

The code works. Run this code in a new document to illustrate.

Code:

Sub Color()
With ActiveDocument
  .Tables.Add Selection.Range, 5, 5
  .Tables(1).Cell(2, 3).Shading.BackgroundPatternColor = RGB(51, 51, 153)
  .Tables(1).Cell(3, 2).Shading.BackgroundPatternColor = RGB(51, 51, 153)
  ChangeLogo ActiveDocument
End With
End Sub
 Function ChangeLogo(wdDoc)
Dim oCell As Cell, oTbl As Table, oRow As Row
Dim i As Long
For Each oTbl In wdDoc.Tables
  For Each oRow In oTbl.Rows
    For Each oCell In oRow.Cells
      If oCell.Shading.BackgroundPatternColor = RGB(51, 51, 153) Then
      oCell.Shading.BackgroundPatternColor = RGB(12, 71, 157)
      End If
    Next
   Next
 Next
  
End Function

gmayor · #9 09-19-2014, 06:36 AM

Quote:

Originally Posted by QA_Compliance_Advisor

and still the text colour won't change.

There is no command in your macro to set the font colour. If you want white text add

oCell.Range.Font.ColorIndex = wdWhite

QA_Compliance_Advisor · #10 09-19-2014, 06:46 AM

Quote:

Originally Posted by gmaxey

The code works. Run this code in a new document to illustrate.

Could you explain why you did what you did - just to give me a better understanding of whats going on with the new code.

Quote:

There is no command in your macro to set the font colour. If you want white text add

oCell.Range.Font.ColorIndex = wdWhite

I tried the code but it never worked - however, I will give it a try again.

gmaxey · #11 09-19-2014, 08:36 AM

I did what I did just to show you that if you isolate the code for evaluating and changing cell shading that it does work. I asked you to run the code I posted in a new document.

That code
1. Created a table
2. Shaded some of the cells with a certain color
3. Then called a function and passed the activedocument as an argument
4. The function evaluated each cell and if the cell shading match that applied in step 2, it changed it to a new color.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro to find text and replace with form field containing that text	iiiiifffff	Word VBA	16	06-04-2016 01:47 AM
Find and Replace multiple table columns	smakdown61	Word	1	08-28-2014 09:24 PM
Word VBA Macro to Find and Replace based on the Alt Text of an Image	bennymc	Word VBA	1	01-27-2014 04:23 PM
Find - Replace Macro using a table list	mdw	Word	0	08-01-2013 04:36 PM
Bad view when using Find and Find & Replace - Word places found string on top line	paulkaye	Word	4	12-06-2011 11:05 PM