2

在 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
4

2 回答 2

0

简介：在这里发表评论的人。出现您的问题是因为代码的执行需要很长时间才能完成，据我所知，应用程序本身不会执行任何事件。如果这需要更长的时间，那么应用程序只是说它不再响应特定的时间跨度。例如，在我的机器上，即使只有 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，这些对于防止应用程序不响应不是必需的，但我发现它们非常有用，因为它们可以防止用户/你/我担心应用程序崩溃。它会在状态栏中告诉您代码当前位于哪一行。

执行期间的状态栏：

在此处输入图像描述

于 2016-11-19T13:38:04.563 回答
0

@Xam Eseerts

感谢您的回答，解决了问题。（Word 在这里运行起来有多慢仍然令人惊讶。为了创建一个彩色的大表格，我终于改用 Excel）。

于 2016-12-04T20:59:29.090 回答