VBA 루프는 첫 번째 반복 후 단어가 멈추거나 충돌합니다.

Question

단어 문서의 각 테이블의 전체 너비를 확인하려고합니다. 첫 번째 반복 후 스크립트가 중단되고 Microsoft Word가 응답하지 않습니다.

Sub fixTableAlignment() 
    For Each tTable In ActiveDocument.Tables 
     Dim tRng As Range 
     Dim sngWdth As Single 
     Set tRng = tTable.Cell(1, 1).Range 
     sngWdth = -tRng.Information(wdHorizontalPositionRelativeToPage) 
     Do While tRng.Cells(1).RowIndex = 1 
     tRng.Move unit:=wdCell, Count:=1 
     Loop 
     tRng.MoveEnd wdCharacter, -1 
     sngWdth = sngWdth + tRng.Information(wdHorizontalPositionRelativeToPage) 
     MsgBox PointsToInches(sngWdth) 
    Next tTable 
    End Sub 

Answer 1

제시된 코드는 단일 행으로 구성된 테이블에 대해서는 작동하지 않습니다. 이 Do While 루프 :

Do While tRng.Cells(1).RowIndex = 1 
    tRng.Move unit:=wdCell, Count:=1 
Loop 

이 밖으로

휴식 후 모든 세포는 행에 단 하나의 행이 있다면 우리가 1 행에 있지 않은 셀을 발견하면 1

Move 방법은 0을 반환 tTable 그래서 방법에서 선언 원래 코드에서 선언되지 않았습니다 (이미 그렇게하지 않을 경우 Option Explicit 사용) : 참고 또한

Dim lngSuccess As Long 

For Each ttable In ThisDocument.Tables 
    Set tRng = ttable.Cell(1, 1).Range 
    sngWdth = -tRng.Information(wdHorizontalPositionRelativeToPage) 

    ' Any non-zero value will do here 
    lngSuccess = 1 
    Do While tRng.Cells(1).RowIndex = 1 And lngSuccess <> 0 
    lngSuccess = tRng.Move(unit:=wdCell, Count:=1) 
    Loop 

    tRng.MoveEnd wdCharacter, -1 
    sngWdth = sngWdth + tRng.Information(wdHorizontalPositionRelativeToPage) 
    MsgBox PointsToInches(sngWdth) 
Next tTable 

를 : 이동이 제대로 완료되지 않으면 때문에이 작동합니다. 오류의 원인이 코드의 일부는 워드가 응답을 중지 할 때 <Ctrl>-<Break>을 눌러 아래로 추적 될 수 있었다 - 이것은 While 루프로 바로 단일 행 테이블에 잘못된 폭 다루는

---

편집을 주도 것 :

이 새 버전에서는 Cell.Width 속성을 사용하여 표의 너비를 측정합니다. 나는

Option Explicit 

Sub fixTableAlignment() 
    Dim tTable As Table 
    Dim cCell As Cell 
    Dim sngWdth As Single 
    Dim bFinished As Boolean 

    For Each tTable In ThisDocument.Tables 
     Set cCell = tTable.Cell(1, 1) 
     sngWdth = 0 

     ' Can't just check the row index as cCell 
     ' will be Nothing when we run out of cells 
     ' in a single-row table. Can't check for 
     ' Nothing and also check the row index in 
     ' the Do statement as VBA doesn't short-circuit 
     bFinished = False 
     Do Until bFinished 
      sngWdth = sngWdth + cCell.Width 
      Set cCell = cCell.Next 

      If (cCell Is Nothing) Then 
       bFinished = True 
      ElseIf (cCell.RowIndex <> 1) Then 
       bFinished = True 
      End If 
     Loop 

     MsgBox PointsToInches(sngWdth) 
    Next tTable 
End Sub