Question

在Word 2016 VBA中，我想用循环设置表的每个单元格的着色。这似乎适用于尺寸约为15 * 15的桌子。使用20 * 20或更大的表格Word不再响应。使用单步时，程序执行似乎是正确的。我试过这个桌子的ca. 50 * 50。 ScreenRefresh和ScreenUpdating似乎没有影响力。在代码示例中，将每个单元格的着色设置为相同的背景颜色仅用于演示，最后我想应用更复杂的设置。

Sub TableCells_SetBackgroundColors()
' Set background color for each cell in Word table
' Application does not respond if table is larger than about 20*20
' debug  single step works in any case
'Application.ScreenUpdating = False

Dim i, k, cntCol, cntRow As Integer
cntCol = 15 ' 20 is not ok
cntRow = 15 ' 20 is not ok
If ActiveDocument.Tables.Count <> 0 Then
    ActiveDocument.Tables(1).Delete
End If
ActiveDocument.Tables.Add Range:=Selection.Range, _
                             numRows:=cntRow, _
                             NumColumns:=cntCol

Dim myTable As Word.Table
Set myTable = Selection.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleSingle
End With
For i = 1 To cntRow Step 1
    For k = 1 To cntCol Step 1
        myTable.Cell(i, k).Shading.BackgroundPatternColor = wdColorRed
        'Application.ScreenRefresh
    Next k
Next i

'Application.ScreenUpdating = True

End Sub

Answer 1

简介：在这里发表评论的人。出现问题是因为代码的执行需要很长时间才能完成应用程序本身不会发生任何事件。据我所知。如果这需要更长的时间，那么应用程序就会说它不再响应了特定的时间跨度。例如，在我的机器上，即使只有15行和列，应用程序也不会响应。有一种方法可以防止这种情况发生：DoEvents。下面是你添加了3行的代码，这些代码在我的机器上非常有效。代码下面是一个更多的解释。

Sub TableCells_SetBackgroundColors()
' Set background color for each cell in Word table
' Application does not respond if table is larger than about 20*20
' debug  single step works in any case
'Application.ScreenUpdating = False

    Dim i, k, cntCol, cntRow As Integer


    cntCol = 21 ' 20 is not ok
    cntRow = 21 ' 20 is not ok
    If ActiveDocument.Tables.Count <> 0 Then
        ActiveDocument.Tables(1).Delete
    End If
    ActiveDocument.Tables.Add Range:=Selection.Range, _
                                 numRows:=cntRow, _
                                 NumColumns:=cntCol

    Dim myTable As Word.Table
    Set myTable = Selection.Tables(1)
    With myTable.Borders
     .InsideLineStyle = wdLineStyleSingle
     .OutsideLineStyle = wdLineStyleSingle
    End With
    For i = 1 To cntRow Step 1

        'New
        Application.StatusBar = "Row " & i & " of " & cntRow
        'New

        For k = 1 To cntCol Step 1
            'New and important
            DoEvents
            'New and important
            myTable.Cell(i, k).Shading.BackgroundPatternColor = wdColorRed
        Next k
    Next i

    'New
    Application.StatusBar = False
    'New

End Sub

更多说明：因此，由于某种原因，Word循环遍历表格的所有单元格并对其应用一些阴影非常慢。这会触发我上面描述的行为。为了防止应用程序没有响应，我在列循环中插入了行DoEvents，以便应用程序在每次迭代过程中“意识到它仍然存在”。在这种情况下，我没有测试 DoEvents 方法有多少性能成本，但是如果你发现它很重要，你可以尝试将 DoEvents 移动到行循环中看你是否还好。对于带有 StatusBar 的其他两行，这些不是防止应用程序无响应的必要条件，但我觉得它们非常有用，因为它们会阻止用户/你/我担心应用程序崩溃。它会在状态栏中告诉您代码当前在哪一行。

执行期间的状态栏：

Answer 2

@Xam Eseerts

感谢您提供解决问题的答案。（令人惊讶的是Word似乎在这里工作的速度有多慢。对于我创建一个大型彩色表的任务，我终于切换到了Excel）。

Word VBA 2016，表：使用循环设置单元格着色时无响应

2 个答案: