突出显示 Word 2010 中已跟踪更改的表格单元格

Question

我希望突出显示带有跟踪更改的表格单元格。

这是我的 VBA 代码：

Sub HiliteChanges()

Dim oTable As Table
Dim oColumn As Column
Dim oCell As Cell
Dim oRange As Range
Dim numRevs As Integer
Dim tableIndex, rowIndex, cellIndex As Integer

For tableIndex = 1 To ActiveDocument.Tables.Count
    For rowIndex = 1 To ActiveDocument.Tables(tableIndex).Rows.Count
        For cellIndex = 1 To ActiveDocument.Tables(tableIndex).Rows(rowIndex).Cells.Count
            numRevs = ActiveDocument.Tables(tableIndex).Rows(rowIndex).Cells(cellIndex).Range.Revisions.Count
            Debug.Print tableIndex, rowIndex, cellIndex, numRevs
            If numRevs > 0 Then
                ActiveDocument.Tables(tableIndex).Rows(rowIndex).Cells(cellIndex).Shading.BackgroundPatternColor = wdColorBlueGray
            End If
        Next
    Next
Next

End Sub

它最终会突出显示整行，即使一行中只有一个单元格被更改。

我在一个 3 行 6 列的表格中进行了更改。变化发生在第一行的第四列。我在运行脚本之前关闭了 Track Changes。这是输出：

1             1             1             1 
1             1             2             1 
1             1             3             1 
1             1             4             1 
1             1             5             1 
1             1             6             1 
1             2             1             0 
1             2             2             0 
1             2             3             0 
1             2             4             0 
1             2             5             0 
1             2             6             0 
1             3             1             0 
1             3             2             0 
1             3             3             0 
1             3             4             0 
1             3             5             0 
1             3             6             0 

所以看起来第一行中的每个单元格都有变化，但事实并非如此。只有一个单元格发生了变化。

有没有办法只突出显示有变化的单元格？ （显然我的方式在某些方面存在缺陷，但我看不出在哪里。）

Answer 1

检查修订时，不要在检查范围内包含“单元格结尾”标记。不要问我为什么会这样......

Sub HiliteChanges()

    Dim oTable As Table
    Dim oColumn As Column, oRow As Row, rng As Range
    Dim oCell As Cell
    Dim oRange As Range
    Dim numRevs As Integer
    Dim tableIndex, rowIndex, cellIndex As Integer

    For tableIndex = 1 To ActiveDocument.Tables.Count

        Set oTable = ActiveDocument.Tables(tableIndex)

        For rowIndex = 1 To oTable.Rows.Count

            Set oRow = oTable.Rows(rowIndex)

            For cellIndex = 1 To oRow.Cells.Count

                Set oCell = oRow.Cells(cellIndex)


                Set rng = oCell.Range
                'don't include the "end of cell" marker in the checked range
                rng.MoveEnd wdCharacter, -1

                numRevs = rng.Revisions.Count

                Debug.Print tableIndex, rowIndex, cellIndex, numRevs

                If numRevs > 0 Then
                    oCell.Shading.BackgroundPatternColor = wdColorBlueGray
                End If
            Next
        Next
    Next

End Sub