用于更改表格颜色的 VBA 宏

VBA Macro to Change Table Colors

提问by ale10ander

I have a Word document which contains several tables. I would like to be able to select the table (or a cell in the table) and have every row in the table be colored in alternating colors. So far, I have created the following code:

我有一个包含多个表格的 Word 文档。我希望能够选择表格（或表格中的一个单元格）并让表格中的每一行都以交替颜色着色。到目前为止，我已经创建了以下代码：

Sub ColorTable()
    '
    ' ColorTable Macro
    ' Alternately colors cells.
    '
    Selection.Collapse Direction:=wdCollapseStart
    If Not Selection.Information(wdWithInTable) Then
          MsgBox "Can only run this within a table"
          Exit Sub
    End If
    Dim RowCount, i, count, ColCount As Integer
    RowCount = ActiveDocument.Tables(1).Rows.count
    i = 0
    ColCount = ActiveDocument.Tables(1).Columns.count
    For i = 1 To RowCount
        For count = 1 To ColCount
            Selection.Shading.BackgroundPatternColor = RGB(184, 204, 228)
            'light
            Selection.MoveRight Unit:=wdCharacter, count:=1
        Next count
        Selection.MoveDown Unit:=wdLine, count:=1
        For count = 1 To ColCount
            Selection.Shading.BackgroundPatternColor = RGB(219, 229, 241)
            'dark
            Selection.MoveRight Unit:=wdCharacter, count:=1
        Next count
    Next i
End Sub

The Macro runs without errors, but changes the cell colors in a diagonal pattern. I'm guessing that the problem lies within my for loops.

宏运行时没有错误，但会以对角线图案更改单元格颜色。我猜问题出在我的 for 循环中。

采纳答案by baltman

With tblNew
  For i = 1 To .Rows.Count Step 2
    .Rows(i).Shading.Texture = wdTexture10Percent
       ' or
    .Rows(i).Shading.BackgroundPatternColor = RGB(219, 229, 241)
  Next
End With

回答by ale10ander

After several months of not thinking about this problem, I found the answer.

几个月没有思考这个问题后，我找到了答案。

Sub colorTable()
Dim rowCount As Integer
Dim colCount As Integer
Dim count As Integer
Dim row, col As Integer


Selection.Collapse Direction:=wdCollapseStart
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Can only be run from a table"
    Exit Sub
End If

rowCount = Selection.Tables(1).Rows.count - 1
colCount = Selection.Tables(1).Columns.count
row = 0
col = 0

While row < rowCount
   count = 1
     While col < colCount
        Selection.Shading.BackgroundPatternColor = RGB(182, 204, 228)
        If count < colCount Then
            Selection.MoveRight unit:=wdCell, count:=1
            count = count + 1
        End If
        col = col + 1
    Wend
    col = 0
    If row = rowCount - 1 And rowCount Mod 2 = 1 Then
        Exit Sub
    End If

    'dark
        Selection.MoveRight unit:=wdCell, count:=1
        count = 1
        'For Each oCOl In Selection.Tables(1).Columns
        While col < colCount
            Selection.Shading.BackgroundPatternColor = RGB(219, 229, 241)
            If count < colCount Then
                Selection.MoveRight unit:=wdCell, count:=1
                count = count + 1
            End If
            col = col + 1
        Wend
        row = row + 2
        If row < rowCount Then
            Selection.MoveRight unit:=wdCell, count:=1
        End If
        col = 0
Wend
End Sub

This probably isn't the best method, I just kind of kludged it together, but it works. I hope it helps somebody!

这可能不是最好的方法，我只是把它拼凑在一起，但它有效。我希望它可以帮助某人！

回答by Uri Goren

I haven't tested it yet, but i think you get the main idea

我还没有测试过，但我想你明白了主要想法

Sub ColorTable()
    Dim RowCount as Integer,s as String, row as Integer, ColCount As Integer
    RowCount = ActiveDocument.Tables(1).Rows.count
    ColCount = ActiveDocument.Tables(1).Columns.count
    For row = 1 To RowCount
        s=replace(Cell(row,1).Address,"$","")
        s=s & ":" & replace(Cell(row,ColCount).Address,"$","")
        Range(s).Shading.BackgroundPatternColor = iif(row mod 2 =0,RGB(184, 204, 228),RGB(219, 229, 241))
        Next count
    Next row
End Sub