How to identify table cell shading color in Word by VBA?

[Sam1085]

Hi,

I have a macro to determine table cell shading color RGB 200, 200, 200. Most of my documents based with this table cell shading RGB color.

Code: Select all

Sub FindTableCellShading()
    Dim TBL             As Table
    Dim C               As Cell
    Dim i               As Long
    Dim n               As Long
    Dim tblNum          As Long
    Dim StandardShade   As Boolean
    Dim tblList         As String

Application.ScreenUpdating = False
Options.Pagination = False

If ActiveDocument.Words.Count = 1 Then
     MsgBox "Seems like this is empty document! Please check and try again.", vbExclamation
  Exit Sub
Else

If ActiveDocument.Tables.Count = 0 Then
     MsgBox "Seems like this document contains no tables", vbExclamation
  Exit Sub
Else

On Error GoTo Error
With ActiveDocument
    tblNum = 0
    For Each TBL In .Tables
        tblNum = tblNum + 1
        n = TBL.Rows.Count
        For i = n To 1 Step -1
            StandardShade = True
            For Each C In TBL.Rows(i).Cells
                ' If cell shading <> "Standard Shading" or "No shading", alert!
                If C.Shading.BackgroundPatternColor <> 13158600 Then ' Standard Shading Color (RGB 200, 200, 200)
                    If C.Shading.BackgroundPatternColor <> 16576719 Then ' Blank Shading (No Color)
                    If C.Shading.BackgroundPatternColor <> wdColorWhite Then ' Blank Shading (No Color)
                    If C.Shading.BackgroundPatternColor <> -603914241 Then ' White, Background 1
                        StandardShade = False
                        Exit For
                    End If
                    End If
                    End If
                End If
            Next C

            If StandardShade = False Then
                tblList = tblList & tblNum & ","
                Exit For
            End If
        Next i
    Next TBL
End With
End If
End If

Set C = Nothing: Set TBL = Nothing
Application.ScreenUpdating = True
Options.Pagination = True

If Len(tblList) > 0 Then
    tblList = Left(tblList, Len(tblList) - 1)
    MsgBox ("Non Standard shading exists in this document in tables:" & vbTab & vbTab & tblList), vbExclamation
Else
    MsgBox ("All shading matches standard color (RGB 200, 200, 200) or is blank"), vbInformation
End If

Exit Sub
Error:
MsgBox ("Seems like this document table(s) contains vertically merged cells! " & tblList), vbExclamation
End Sub

But some times my documents based with different cell shading color. In this case, I have to go to VBA editor and need to change color code in VBA to run this macro.

I think it would be very helpful me if can add a input RGB color user forum before run this macro. But the problem is I have no idea how to convert RGB to VBA color code. Any options to do this?

Thank you!
Have a great weekend.

[HansV]

VBA has a RGB function for this purpose.
Let's say you have variables (or controls) lngRed, lngGreen and lngBlue, each with a value between 0 and 255.
You can use RGB(lngRed, lngGreen, lngBlue) to convert this to the long integer that VBA uses.

[Sam1085]

Thank you Hans,

Your guidance always help me.

Code: Select all

Private Sub allcmdOK_Click()
Application.ScreenUpdating = False
    Dim lngRed          As Long
    Dim lngGreen        As Long
    Dim lngBlue         As Long
    Dim lngRGB          As Long
    Dim tbl             As Table
    Dim C               As Cell
    Dim i               As Long
    Dim n               As Long
    Dim tblNum          As Long
    Dim StandardShade   As Boolean
    Dim tblList         As String

    lngRed = Val(Me.Red)
    If Me.Red = "" Or lngRed < 0 Or lngRed > 255 Then
        Me.Red.SetFocus
        MsgBox "Please enter a value between 0 and 255!"
        Exit Sub
    End If

    lngGreen = Val(Me.Green)
    If Me.Green = "" Or lngGreen < 0 Or lngGreen > 255 Then
        Me.Green.SetFocus
        MsgBox "Please enter a value between 0 and 255!"
        Exit Sub
    End If

    lngBlue = Val(Me.Blue)
    If Me.Blue = "" Or lngBlue < 0 Or lngBlue > 255 Then
        Me.Blue.SetFocus
        MsgBox "Please enter a value between 0 and 255!"
        Exit Sub
    End If

    lngRGB = RGB(lngRin, lngGin, lngBin)

On Error GoTo Error
With ActiveDocument
    tblNum = 0
    For Each tbl In .Tables
        tblNum = tblNum + 1
        n = tbl.Rows.Count
        For i = n To 1 Step -1
            StandardShade = True
            For Each C In tbl.Rows(i).Cells
                ' If cell shading <> "Standard Shading" or "No shading", alert!
                If C.Shading.BackgroundPatternColor <> lngRGB Then ' Standard Shading Color (RGB 207, 240, 252)
                    If C.Shading.BackgroundPatternColor <> 16576719 Then ' Blank Shading (No Color)
                    If C.Shading.BackgroundPatternColor <> wdColorWhite Then ' Blank Shading (No Color)
                    If C.Shading.BackgroundPatternColor <> -603914241 Then ' White, Background 1
                        StandardShade = False
                        Exit For
                    End If
                    End If
                    End If
                End If
            Next C

            If StandardShade = False Then
                tblList = tblList & tblNum & ","
                Exit For
            End If
        Next i
    Next tbl
End With
Me.Hide
Set C = Nothing: Set tbl = Nothing

If Len(tblList) > 0 Then
    tblList = Left(tblList, Len(tblList) - 1)
    MsgBox ("Non ADDS Standard shading exists in this document in tables:" & vbTab & vbTab & tblList), vbExclamation
Else
    MsgBox ("All shading matches standard color (RGB 200, 200, 200) or is blank"), vbInformation
End If

Exit Sub
Error:
MsgBox ("Something Went Wrong! Please Try Again" & tblList), vbExclamation

Me.Hide
Application.ScreenUpdating = True
End Sub

This works for me. Thank you!

[Sam1085]

Hi everyone,

The above mentioned code works for me to identify table shading inconsistencies. But doesn't have any option to ignore 'No Color'. Any option to ignore 'No Color' inside the VBA?

I tried this as follows. Any better way to do this...

Code: Select all

If C.Shading.BackgroundPatternColor <> wdColorAutomatic Then ' Blank Shading (No Color)

[HansV]

An alternative would be

If C.Shading.BackgroundPatternColorIndex <> wdNoHighlight Then ' Blank Shading (No Color)

[Sam1085]

Thank you Hans. I just tried wdNoHighlight. But it doesn't ignore 'No Color'. (Tested in Word 2010)

img.png

[HansV]

Did you use BackgroundPatternColorIndex instead of BackgroundPatternColor?

[Sam1085]

Thank you Hans!

I used BackgroundPatternColor... My bad.