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来衡量单行表宽度的可靠方法

{{1}}

第一次迭代后，VBA循环冻结/崩溃字

1 个答案: