1

Word文書の各テーブルの合計幅を決定しようとしています。最初の反復の後、スクリプトがハングし、MicrosoftWordが応答を停止します。

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つしかない場合は、すべてのセルが行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 に答える