The macro below should do what you want. Note that the macro checks the
tables row by row. The shading will only be replaced if the specified “oldâ€
color has been applied to the entire row (that is how I understood your
description). Changes to the macro are needed if the macro must find shading
applied to individual cells.
The macro could most likely be made more elegant but it should work. Note
that RGB values must be specified with 3 digits.
Sub Table_ReplaceRowShadingColor()
Dim Msg_ColorOld As String
Dim Msg_ColorNew As String
Dim Response As VbMsgBoxResult
Dim oTable As Table
Dim oRow As Row
Dim R_Old As String
Dim G_Old As String
Dim B_Old As String
Dim R_New As String
Dim G_New As String
Dim B_New As String
Dim n As Long
Dim nCount As Long
Dim strInput As String
'Create messages
Msg_ColorOld = "Please enter the RGB values (use 3 digits and separate
by semicolons) " & _
"of the shading you would like to change for all the tables " & _
"in the current document." & vbCr & _
"Example: 224;005;089"
Msg_ColorNew = "Please enter the RGB value (use 3 digits and separate by
semicolons) " & _
"of the replacement color:" & vbCr & _
"Example: 224;005;089"
'Use same code for two inputboxes
For n = 1 To 2
Retry:
Select Case n
Case 1
strInput = InputBox(Msg_ColorOld, "Specify Current Shading
Color", strInput)
Case 2
strInput = InputBox(Msg_ColorNew, "Specify New Shading Color")
End Select
If Len(strInput) = 0 Then
If StrPtr(strInput) = 0 Then
'Cancel clicked
Exit Sub
Else
'OK clicked, empty field
Response = MsgBox("You must specify a color. Please retry.",
vbRetryCancel, "Specify Color")
If Response = vbRetry Then
GoTo Retry
Else
Exit Sub
End If
End If
Else
'input - validate syntax
If strInput Like "[0-2]##;[0-2]##;[0-2]##" = False Then
ShowMsg:
Response = MsgBox("The syntax of the color you specified is
not correct. Please retry.", vbRetryCancel, "Specify Color")
If Response = vbRetry Then
GoTo Retry
Else
Exit Sub
End If
End If
'If a value exceeds 255, retry
If Split(strInput, ";")(0) > 255 Or Split(strInput, ";")(1) >
255 Or Split(strInput, ";")(2) > 255 Then
GoTo ShowMsg
End If
'Input OK
Select Case n
Case 1
R_Old = Split(strInput, ";")(0)
G_Old = Split(strInput, ";")(1)
B_Old = Split(strInput, ";")(2)
Case 2
R_New = Split(strInput, ";")(0)
G_New = Split(strInput, ";")(1)
B_New = Split(strInput, ";")(2)
End Select
End If
Next n
nCount = 0
'Replace shading in all tables
For Each oTable In ActiveDocument.Tables
For Each oRow In oTable.Rows
If oRow.Shading.BackgroundPatternColor = RGB(R_Old, G_Old,
B_Old) Then
oRow.Shading.BackgroundPatternColor = RGB(R_New, G_New, B_New)
nCount = nCount + 1
End If
Next oRow
Next oTable
MsgBox "Finished. The shading of " & nCount & " rows has been changed."
End Sub
--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmarkwww.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word
andreas said:
Dear Experts:
I got a document, in which all tables have an alternate white / grey
shading of the rows. I now would like to be able to change this grey
shading in one go for all tables with the help of an input box, e.g.
First Input Box: Please enter the RGB value (separated by semicolons)
of the shading you would like to change for all the tables in the
curren document !
Second InputBox: Please enter the RGB value of the replacement color.
Help is much appreciated. Thank you very much in advance. Regards,
Andreas- Hide quoted text -
- Show quoted text -
