見出し画像

【Word マクロ】ページ外側に側注テキストボックスを自動生成

はじめに

Wordで冊子タイプの資料を作成する際、ページの外側に側注を設置する必要がある場合、手動で位置を調整するのは煩雑で時間がかかります。しかし、VBAを使えば、この作業を自動化することができます。
この記事では、ページの外側に自動で側注ボックスを追加するVBAコードの紹介と解説を行います。
マクロやVBAについて全く知らない場合は、以下サポートを参考にしてみてください。

環境

使用アプリケーション:Microsoft365 Apps for business Word
OS:Windows11

マクロの実行で目指す処理

  • 偶数ページ奇数ページで異なる側注テキストボックスの設定

  • ページが増えたときにテキストボックスを追加する

  • ページ増減によりテキストボックスが内側に配置された場合、外側に位置を修正する

完成したVBAコード

このVBAコードは、Wordドキュメント内の各ページに「側注ボックス」という名前のテキストボックスを追加し、フォントやレイアウトを設定するものです。

Sub AddFootnoteBox()
    Dim doc As Document
    Dim pg As Long
    Dim shp As Shape
    Dim tb As Shape
    Dim pageWidth As Single
    Dim pageHeight As Single
    Dim marginLeft As Single
    Dim marginRight As Single
    Dim marginTop As Single
    Dim marginBottom As Single
    Dim tbWidth As Single
    Dim tbHeight As Single
    
    Set doc = ActiveDocument
    
    ' ドキュメント内のすべてのシェイプを逆順にループ
    Dim i As Long
    For i = doc.Shapes.Count To 1 Step -1
        Set shp = doc.Shapes(i)
        
        If shp.Type = msoTextBox Then
            ' シェイプのアンカーがどのページにあるか確認
            pg = shp.Anchor.Information(wdActiveEndPageNumber)
            If Strings.Left(shp.Name, 6) = "側注ボックス" Then
                ' 名前が「側注ボックス&ページ番号」になっているかを確認
                If shp.Name <> "側注ボックス" & pg Then
                    ' ページ番号が異なる場合、名前を変更
                    Dim tempName As String
                    tempName = "側注ボックス" & pg
                    shp.Name = tempName
                End If
                ' レイアウトの修正
                SetTextBoxLayout shp, pg, doc
                SetTextBoxFontDefault shp
            End If
        End If
    Next i
    
    ' 各ページをループして「側注ボックス」が無いページに追加
    For pg = 1 To doc.ComputeStatistics(wdStatisticPages)
        
        Dim hasFootnoteBox As Boolean ' 「側注ボックス」の有無フラグ
        hasFootnoteBox = False
        
        For Each shp In doc.Shapes
            If shp.Type = msoTextBox Then
                If shp.Anchor.Information(wdActiveEndPageNumber) = pg And Strings.Left(shp.Name, 6) = "側注ボックス" Then
                    hasFootnoteBox = True
                    Exit For
                End If
            End If
        Next shp
        
        If Not hasFootnoteBox Then ' 「側注ボックス」がない場合
            Dim pageRange As Range
            Set pageRange = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pg)
            Set tb = doc.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 10, 10, pageRange)
            tb.Name = "側注ボックス" & pg
            
            ' テキストボックスのレイアウトを設定
            SetTextBoxSizeDefault tb, pg, doc
            SetTextBoxFontDefault tb
            SetTextBoxLayout tb, pg, doc
        End If
    Next pg
End Sub

Sub SetTextBoxSizeDefault(tb As Shape, pg As Long, doc As Document)
    ' ページのサイズと余白を取得
    pageWidth = doc.PageSetup.pageWidth
    pageHeight = doc.PageSetup.pageHeight
    marginLeft = doc.PageSetup.LeftMargin
    marginRight = doc.PageSetup.RightMargin
    marginTop = doc.PageSetup.TopMargin
    marginBottom = doc.PageSetup.BottomMargin
    
    ' テキストボックスのサイズを設定
    tb.Width = 50 * 2.835 ' mmをポイントに変換 (1mm = 2.835ポイント)
    tb.Height = pageHeight - marginTop - marginBottom
End Sub

Sub SetTextBoxFontDefault(tb As Shape)
    ' フォントを「MS ゴシック」に変更
    With tb.TextFrame.TextRange.Font
        .Name = "MS ゴシック"
        .Size = 5 ' 文字サイズを5ptに設定
    End With
    
    ' 行間を固定値7ptに変更
    With tb.TextFrame.TextRange.ParagraphFormat
        .LineSpacingRule = wdLineSpaceExactly ' 固定値
        .LineSpacing = 7 ' 行間を7ptに設定
    End With
    
    ' テキストボックスの背景色を#F2F2F2に変更
    tb.Fill.ForeColor.RGB = RGB(242, 242, 242)
    
    ' テキストボックスの枠線を無くす
    tb.Line.Visible = msoFalse
End Sub

Sub SetTextBoxLayout(tb As Shape, pg As Long, doc As Document)
    ' ページのサイズと余白を取得
    pageWidth = doc.PageSetup.pageWidth
    pageHeight = doc.PageSetup.pageHeight
    marginLeft = doc.PageSetup.LeftMargin
    marginRight = doc.PageSetup.RightMargin
    marginTop = doc.PageSetup.TopMargin
    marginBottom = doc.PageSetup.BottomMargin
    
    ' レイアウトの設定
    With tb
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        .LockAnchor = False
        .LayoutInCell = False
    End With
    
    ' 水平方向の位置を設定
    If pg Mod 2 = 0 Then
        ' 偶数ページの場合、左の余白に寄せる
        tb.Left = 0
    Else
        ' 奇数ページの場合、右の余白に寄せる
        tb.Left = pageWidth - tb.Width - marginRight - marginLeft
    End If
    
    ' 垂直方向の位置を設定
    tb.Top = pageHeight - marginTop - marginBottom - tb.Height
    
    ' 文字列の折り返し設定
    With tb.WrapFormat
        .Type = wdWrapSquare
        .Side = wdWrapBoth
        .DistanceLeft = 3 * 2.835 ' mmをポイントに変換
        .DistanceRight = 3 * 2.835 ' mmをポイントに変換
    End With
End Sub

VBAコードの解説

コードの各部分を詳しく解説します。

追加されるテキストボックスの名前

追加されるテキストボックスは「側注ボックス[ページ数]」という名前に変更しています。テキストボックスか否かだけで処理を分けた場合、側注の他にもテキストボックスが存在した場合に不要な処理を行ってしまうからです。
また、ドキュメント内には同じ名前のテキストボックスを配置できないためご注意ください。

変数の宣言と初期化

Dim doc As Document
Dim pg As Long
Dim shp As Shape
Dim tb As Shape
Dim pageWidth As Single
Dim pageHeight As Single
Dim marginLeft As Single
Dim marginRight As Single
Dim marginTop As Single
Dim marginBottom As Single
Dim tbWidth As Single
Dim tbHeight As Single

Set doc = ActiveDocument
  • doc:現在のアクティブなドキュメントを指します。

  • pg:ページ番号を格納するための変数です。

  • shp、tb:シェイプ(図形)オブジェクトを格納するための変数です。

  • pageWidth、pageHeight、marginLeft、marginRight、marginTop、marginBottom:ページのサイズと余白を格納するための変数です。

  • tbWidth、tbHeight:テキストボックスのサイズを格納するための変数です。

既存のテキストボックスの処理

Dim i As Long
For i = doc.Shapes.Count To 1 Step -1
    Set shp = doc.Shapes(i)

    If shp.Type = msoTextBox Then
        pg = shp.Anchor.Information(wdActiveEndPageNumber)
        If Strings.Left(shp.Name, 6) = "側注ボックス" Then
            If shp.Name <> "側注ボックス" & pg Then
                Dim tempName As String
                tempName = "側注ボックス" & pg
                shp.Name = tempName
            End If
            SetTextBoxLayout shp, pg, doc
            SetTextBoxFontDefault shp
        End If
    End If
Next i
  • ドキュメント内のすべてのシェイプを逆順にループします。

  • シェイプがテキストボックスである場合、そのアンカーがどのページにあるかを確認します。

  • 名前が「側注ボックス」で始まる場合、ページ番号が異なる場合は名前を変更します。

  • SetTextBoxLayoutとSetTextBoxFontDefaultを呼び出して、レイアウトとフォントを設定します。

各ページに『側注ボックスを追加』

For pg = 1 To doc.ComputeStatistics(wdStatisticPages)
    Dim hasFootnoteBox As Boolean
    hasFootnoteBox = False

    For Each shp In doc.Shapes
        If shp.Type = msoTextBox Then
            If shp.Anchor.Information(wdActiveEndPageNumber) = pg And Strings.Left(shp.Name, 6) = "側注ボックス" Then
                hasFootnoteBox = True
                Exit For
            End If
        End If
    Next shp

    If Not hasFootnoteBox Then
        Dim pageRange As Range
        Set pageRange = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pg)
        Set tb = doc.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 10, 10, pageRange)
        tb.Name = "側注ボックス" & pg

        SetTextBoxSizeDefault tb, pg, doc
        SetTextBoxFontDefault tb
        SetTextBoxLayout tb, pg, doc
    End If
Next pg
  • ドキュメント内の各ページをループして、「側注ボックス」が無いページに追加します。

  • SetTextBoxSizeDefault、SetTextBoxFontDefault、SetTextBoxLayoutを呼び出して、テキストボックスのサイズ、フォント、レイアウトを設定します。

ここまでがメインとなる部分です。
続いて、サブプロシージャについて解説します。

テキストボックスのサイズを設定するサブプロシージャ

Sub SetTextBoxSizeDefault(tb As Shape, pg As Long, doc As Document)
    pageWidth = doc.PageSetup.pageWidth
    pageHeight = doc.PageSetup.pageHeight
    marginLeft = doc.PageSetup.LeftMargin
    marginRight = doc.PageSetup.RightMargin
    marginTop = doc.PageSetup.TopMargin
    marginBottom = doc.PageSetup.BottomMargin

    tb.Width = 50 * 2.835 ' mmをポイントに変換 (1mm = 2.835ポイント)
    tb.Height = pageHeight - marginTop - marginBottom
End Sub
  • ページのサイズと余白を取得し、テキストボックスのサイズを設定します。

テキストボックスのフォントと背景色を設定するサブプロシージャ

Sub SetTextBoxFontDefault(tb As Shape)
    With tb.TextFrame.TextRange.Font
        .Name = "MS ゴシック"
        .Size = 5 ' 文字サイズを5ptに設定
    End With

    With tb.TextFrame.TextRange.ParagraphFormat
        .LineSpacingRule = wdLineSpaceExactly ' 固定値
        .LineSpacing = 7 ' 行間を7ptに設定
    End With

    tb.Fill.ForeColor.RGB = RGB(242, 242, 242) ' 背景色を#F2F2F2に変更
    tb.Line.Visible = msoFalse ' 枠線を無くす
End Sub
  • フォントを「MS ゴシック」に変更し、文字サイズを5ptに設定します。

  • 行間を固定値7ptに設定します。

  • テキストボックスの背景色を#F2F2F2に変更し、枠線を無くします。

テキストボックスのレイアウトを設定するサブプロシージャ

Sub SetTextBoxLayout(tb As Shape, pg As Long, doc As Document)
    pageWidth = doc.PageSetup.pageWidth
    pageHeight = doc.PageSetup.pageHeight
    marginLeft = doc.PageSetup.LeftMargin
    marginRight = doc.PageSetup.RightMargin
    marginTop = doc.PageSetup.TopMargin
    marginBottom = doc.PageSetup.BottomMargin

    With tb
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        .LockAnchor = False
        .LayoutInCell = False
    End With

    If pg Mod 2 = 0 Then
        tb.Left = 0 ' 偶数ページの場合、左の余白に寄せる
    Else
        tb.Left = pageWidth - tb.Width - marginRight - marginLeft ' 奇数ページの場合、右の余白に寄せる
    End If

    tb.Top = pageHeight - marginTop - marginBottom - tb.Height

    With tb.WrapFormat
        .Type = wdWrapSquare
        .Side = wdWrapBoth
        .DistanceLeft = 3 * 2.835 ' mmをポイントに変換
        .DistanceRight = 3 * 2.835 ' mmをポイントに変換
    End With
End Sub
  • ページのサイズと余白を取得し、テキストボックスのレイアウトを設定します。

  • 偶数ページの場合は左の余白に、奇数ページの場合は右の余白にテキストボックスを配置します。

  • テキストボックスの垂直方向の位置を設定し、文字列の折り返し設定を行います。

まとめ

このコードにより、ドキュメント内の各ページに「側注ボックス」が適切に配置され、フォントやレイアウトが設定されます。ページ数が増えると実行に時間がかかる場合があるのでご注意ください。
ご使用の際には、テキストボックスの書式設定など、お好みで変更をしてください。CopilotをはじめとするAIツールを活用することもおすすめします。

おしらせ

電巧社ではセキュリティ分野専門のブログも公開しています。ゼロトラストセキュリティを始めとした、ランサムウェアへの対処法等を紹介しています。こちらもよろしくお願いします。

↓↓ゼロトラストセキュリティ製品『Color Tokens』はこちらから!!↓↓

https://de-denkosha.co.jp/product/cyber-sec/colortokens/