Word VBA: 根据cell内容修改cell背景色

收藏到CSDN网摘
项目需要做用户指南,需要做个表格来描述各个功能是否支持当前对象.最开始的想法是用vba枚举表格,判断caption是否是所需表格,然后枚举cell,判断内容并修改背景色.可惜截至word2013(包括以前版本),table caption并没有单独作为一个对象来使用,而是普通文本,只是使用了caption样式而已.换句话说:word表格caption与表格对象无关!你可以在表格caption与表格之间插入任何内容,包括另外一个表格,并不影响word显示和使用.但是对自动化操作(例如vba)造成了不小的影响.怎么解决这个问题呢?

笨办法就是枚举表格,通过不同表格内容不同(虽然有时候也有可能相同)来if...else...判断处理,但是如果文档很大,包含多个表格,这种办法效率非常低下.

这时就得采取曲线救国的策略,虽然word vba本身不能直接获取到某个caption对应的表格,但是可以给表格添加一个bookmark,然后通过bookmark直接定位并获取表格对象,进而执行各种操作.

下面的例子就是给表格添加一个叫Table1的bookmark,然后用vba判断并获取表格对象来操作的例子:
注意:
1.word2013中测试过这个例子中
2.单元格内容是添加的drop-down list content control,可以完美支持
3.bookmark的名称必须区分大小写.
4.bookmark可以通过.Name来访问具体内容
5.word vba中table还有.Title属性,可以用vba直接访问并修改,但是没有对应的GUI操作方法(所以这里没有用).

测试过程及文档如下:

测试代码如下:

Sub change_text()
Dim oTable As Table
If ActiveDocument.Bookmarks.Exists("Table1") Then
    Set oTable = ActiveDocument.Bookmarks("Table1").Range.Tables(1)
    MsgBox oTable.Title
    Dim oRow As Row
    Dim oCel As Cell
    Dim oRng As Range
    For Each oRow In oTable.Rows
        For Each oCel In oRow.Cells
            Set oRng = oCel.Range
            MsgBox oRng.Text
            If Len(oRng.Text) > 5 Then
                If InStr(1, Trim(oRng.Text), "not", vbTextCompare) Then
                    oCel.Shading.BackgroundPatternColorIndex = wdRed
                ElseIf InStr(1, Trim(oRng.Text), "safe", vbTextCompare) Then
                    oCel.Shading.BackgroundPatternColorIndex = wdYellow
                ElseIf InStr(1, Trim(oRng.Text), "implemented", vbTextCompare) Then
                    oCel.Shading.BackgroundPatternColorIndex = wdBrightGreen
                End If
            End If
        Next
    Next
End If
End Sub

Update:
注意上面的代码只适用于没有vertical merge cell的表格,如果合并过单元格,运行时会返回5991错误,并显示错误信息
"Cannot access individual rows in this collection because the table has vertically merged cells."
解决方法是避免使用for each来枚举row和column,而是用table的range.cells来枚举所有cell.核心代码如下:

For i = 1 To oTable.Range.Cells.Count
        Set oCel = oTable.Range.Cells(i)
        With oCel
            If InStr(1, Trim(.Range.Text), "not", vbTextCompare) Then
                .Shading.BackgroundPatternColorIndex = wdRed
            ElseIf InStr(1, Trim(.Range.Text), "safe", vbTextCompare) Then
                .Shading.BackgroundPatternColorIndex = wdYellow
            ElseIf InStr(1, Trim(.Range.Text), "implemented", vbTextCompare) Then
                .Shading.BackgroundPatternColorIndex = wdBrightGreen
            End If
        End With
Next i

也可以将改变单元格背景的步骤做成子函数,在主函数中调用(call),例如:

Sub Update_Tables()
' update table colours for tb_fluid_vol_xml, tb_flownet_xml, tb_meshing_xml
' and tb_precise_xml. the background colour of cells will be determinted by
' the value of the drop-down list content control.
Dim oTable As Table
If ActiveDocument.Bookmarks.Exists("Table1") Then
    Set oTable = ActiveDocument.Bookmarks("Table1").Range.Tables(1)
    Call Change_Cell_Background(oTable)
End If
End Sub

Sub Change_Cell_Background(oTable As Table)
Dim oCel As Cell
For i = 1 To oTable.Range.Cells.Count
    Set oCel = oTable.Range.Cells(i)
    With oCel
        If InStr(1, Trim(.Range.Text), "not", vbTextCompare) Then
            .Shading.BackgroundPatternColorIndex = wdRed
        ElseIf InStr(1, Trim(.Range.Text), "compatible", vbTextCompare) Then
            .Shading.BackgroundPatternColorIndex = wdYellow
        ElseIf InStr(1, Trim(.Range.Text), "implemented", vbTextCompare) Then
            .Shading.BackgroundPatternColorIndex = wdBrightGreen
        End If
    End With
    Next i
End Sub