Word VBA 2016, 테이블 : 루프를 사용하여 셀의 음영을 설정할 때 응답 없음

Word 2016 VBA에서 루프를 사용하여 테이블의 각 셀 음영을 설정하려고합니다. 약 15 * 15 크기의 테이블에서 작동하는 것으로 보입니다. 20 * 20 이상의 테이블과 같은 Word에서는 더 이상 응답하지 않습니다. 단일 단계를 사용하는 경우에도 프로그램 실행이 올바른 것처럼 보입니다. 나는 ca의 테이블을 위해 이것을 시험해 보았다. 50 * 50. ScreenRefresh 및 ScreenUpdating은 영향을 미치지 않는 것 같습니다. 코드 예제에서 각 셀의 음영을 동일한 배경색으로 설정하는 것은 데모 용이며 마지막으로 좀 더 복잡한 설정을 적용하려고합니다.Word VBA 2016, 테이블 : 루프를 사용하여 셀의 음영을 설정할 때 응답 없음

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

출처

2016-11-19 ht2016

응용 프로그램이 더 이상 응답하지 않을 때 대기하려고 했습니까? 코드 실행이 오랜 시간이 걸리면 모든 오피스 애플리케이션은 내가 생각하는 한이 행동을 보입니다.하지만 대개는 기다려도 괜찮습니다. –

소개 : 여기에 댓글을 달았 남자. 문제는 응용 프로그램 자체가 내가 아는 한 모든 이벤트를 수행하지 않는 곳에서 코드를 실행하는 데 오랜 시간이 걸리기 때문에 발생합니다. 시간이 오래 걸리면 응용 프로그램에서 더 이상 응답하지 않는다고 말합니다. 예를 들어 내 컴퓨터에서 응용 프로그램은 단지 15 개의 행과 열로도 더 이상 응답하지 않습니다. 이 문제를 방지하는 방법이 하나 있습니다 : DoEvents. 아래 코드는 내 컴퓨터에 georgously 작동하는 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

더 설명 : 그래서 어떤 이유로 말씀이 테이블의 모든 세포를 통해 반복 그들에게 약간의 음영을 적용하는 매우 느립니다. 위에서 설명한 동작이 트리거됩니다. 응용 프로그램이 응답하지 않도록하려면 열 순환에 DoEvents 행을 삽입하여 응용 프로그램이 모든 셀 반복 중에 "여전히 살아 있음을 인식"하도록하십시오. 얼마나 많은 성능 비용을 테스트하지 않았습니까? DoEvents 메서드는이 경우에 해당합니다. 그러나 중요한 것으로 판단되면 DoEvents을 행 루프로 이동하고 여전히 정상적으로 작동하는지 확인할 수 있습니다. StatusBar가 인 다른 두 줄에 대해서는 응용 프로그램이 응답하지 못하도록 방지 할 필요는 없지만 사용자/사용자/사용자가 응용 프로그램이 다운되었다는 것을 걱정하지 않기 때문에 매우 유용합니다. 코드가 현재있는 행의 상태 표시 줄에서 알려줍니다. 실행 중에

상태 표시 :