1

试图确定 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
4

1 回答 1

2

呈现的代码不适用于由单行组成的表。这个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如果尚未这样做，请使用）。当 Word 停止响应时，可以通过按下来跟踪导致错误的代码部分<Ctrl>-<Break>- 这将直接引导您进入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
于 2012-11-29T07:36:19.300 回答