画像・図形の幅をレイアウトに合わせて最適化する

Wordで画像や図形が余白にはみ出していたり、ドラッグで適当に調整した結果サイズがまちまちだったりということがよくあります。そうした画像や図形のサイズを、段落の幅に合わせてきちんとそろえるマクロです。

なお、ここで扱う画像や図形は「行内」で配置されたものを対象としています。

図 (InlineShape)、図形(Shape/wdWrapInline)の幅を最適化するマクロ

選択範囲内にある図 (InlineShape)、図形・行内(Shape/wdWrapInline)の幅を、配置されている段落領域の幅に合わせます。

Sub 図と図形の幅を最適化()

    Dim i As Long
    Dim widRng As Single  ' 編集領域有効幅
    Dim widFull As Single '画像原寸幅(ポイント)

    With Selection.Range
        For i = 1 To .ShapeRange.Count
            With .ShapeRange(i)
                If .WrapFormat.Type = wdWrapInline Then
                    .Width = f_GetMaxWidth(.Anchor)
                End If
            End With
        Next i
    End With

    With Selection
        For i = 1 To .InlineShapes.Count
            With .InlineShapes(i)
                widRng = f_GetMaxWidth(.Range)
                Select Case .Width - widRng
                Case Is > 0 '縮小不足(はみ出し)の対応
                    .Width = widRng
                Case Is < 0 '縮小過多の対応(原寸以下かつ領域幅内)
                    If .ScaleWidth < 100 Then
                        widFull = .Width / (.ScaleWidth / 100) '原寸
                        If widFull < widRng Then
                            ScaleWidth = 100
                        Else
                            .Width = widRng
                        End If
                    End If
                End Select
                '縦横比が異なる場合はそろえる
                If .ScaleHeight <> .ScaleWidth Then
                    ScaleHeight = .ScaleWidth
                End If
            End With
        Next i
    End With
End Sub

Function f_GetMaxWidth(RNG As Range) As Single
    Dim widMax As Single
    With RNG
        If .Information(wdWithInTable) Then
            '表内の場合はセル幅と余白値から
            With .Cells(1)
                widMax = .Width - (.LeftPadding + .RightPadding)
            End With
        Else
            'セクション幅(段組幅が異なる場合には非対応)
            widMax = .Sections(1).PageSetup.TextColumns(1).Width
        End If
        '段落の幅(左右インデント)
        With .Paragraphs(1)
            widMax = widMax - (.LeftIndent + RightIndent)
        End With
    End With
    f_GetMaxWidth = widMax
End Function