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 しかない場合でも、アプリケーションが応答しなくなりました。これを防ぐ方法が 1 つあります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の他の 2 行については、、これらはアプリケーションが応答しないのを防ぐために必要ではありませんが、ユーザー/あなた/私がアプリケーションがクラッシュしたことを心配するのを防ぐため、非常に便利だと思います. ステータスバーに、コードが現在どの行にあるかが表示されます。

実行中のステータスバー:

ここに画像の説明を入力

于 2016-11-19T13:38:04.563 に答える