表の幅を最適化する(インデント維持)

別のデータからコピーした大きな表を貼り付けたり、ドラッグ操作で拡大しすぎたりすると、表が余白やページ端からはみ出してしまうことがあります。あるいは、ドラッグで調整した表のサイズが不ぞろいで恰好が悪くなったりします。このマクロはそうした表の幅をきれいに調整するものです。

以下のトピックで画像のサイズ調整マクロを掲示しましたが、今回はその表バージョンです。

Sub 表の幅をレイアウトに合わせる()
    Dim aTbl As Table
    Dim widRng As Single   

    On Error GoTo OnERR
    For Each aTbl In Selection.Tables
        With aTbl
            '表内(ネスト)の場合はオートフィット
            If .Tables.NestingLevel > 2 Then
                .AutoFitBehavior wdAutoFitWindow
            'インデントは維持してレイアウト上の最大幅に
            Else
                If .Rows.LeftIndent < 0 Then .Rows.LeftIndent = 0
                widRng = f_GetMaxWidth(.Range)
                '表のインデント幅を反映
                widRng = widRng - .Rows.LeftIndent
                .PreferredWidthType = wdPreferredWidthPoints
                .PreferredWidth = widRng
            End If
        End With
    Next aTbl

ENDUP:
    Set aTbl = Nothing
    Exit Sub
OnERR:
    MsgBox Err.Number & ":" & Err.Description, vbCritical, "エラーが発生しました"
    GoTo ENDUP
End Sub
' ==========================================
' 選択領域の版面幅(セクション段組幅 - 段落インデント幅)を求める
Function f_GetMaxWidth(aRng As Range) As Single

    Dim numSec As Variant
    Dim widRng As Single

    With aRng
        'セクション番号を求める
        numSec = .Information(wdActiveEndSectionNumber)
        'セクション幅(段組幅が異なる場合には非対応)
        widRng = .Parent.Sections(numSec).PageSetup.TextColumns(1).Width
    End With
    f_GetMaxWidth = widRng
End Function
[ウィンドウ幅に自動調整]コマンドでも表の幅の自動調整はできます。VBAではテーブルオブジェクト.AutoFitBehavior wdAutoFitWindow です(上記マクロの一部にも使用)。
ただしこれらの処理では表に設定されたインデントが解除されてしまう点が困る場合があります。上記のマクロは、そうしたインデント設定を維持した最適化を想定しています。

 

タイトルとURLをコピーしました