VBA循環在第一次迭代後凍結/崩潰

Question

嘗試確定Word文檔中每個表的總寬度。第一次迭代後，腳本掛起並且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如果此舉失敗所以這應該工作：

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 

另外值得注意的是：tTable沒有在原來的代碼中聲明的宣佈，它的方法（和使用Option Explicit，如果沒有這樣做）。導致錯誤的代碼的一部分可能已經找到了按<Ctrl>-<Break>當Word停止響應 - 這將導致你直接到While循環

---

編輯處理上的單行表不正確寬度：

這個新版本使用Cell.Width屬性來衡量表的寬度。我找不到使用Range.Information來測量單排表格寬度的可靠方法

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