Word VBA/マクロ 備忘録

作業効率化のため作成したマクロをバックアップ代わりにアップしていきます。

【Word VBA/マクロ】カーソル位置にタブ追加

サンプルコードでできること

カーソルの位置にタブを追加します。
ルーラーのタブボタンから、タブの種類の選択なしでタブを追加できます。

Sub 左タブを追加()
    AddTab wdAlignTabLeft
End Sub

Sub 右タブ追加()
    AddTab wdAlignTabRight
End Sub

Sub 中央タブ追加()
    AddTab wdAlignTabCenter
End Sub

Private Sub AddTab(stHaichi As String)
'カーソルの位置にタブを追加します
    Dim posi As Single

    'カーソル位置
    posi = Selection. _
        Information(wdHorizontalPositionRelativeToTextBoundary)

        Selection.ParagraphFormat.TabStops.Add _
            Position:=posi, Alignment:=stHaichi, _
            Leader:=wdTabLeaderSpaces
End Sub

コードの説明

    posi = Selection. _
        Information(wdHorizontalPositionRelativeToTextBoundary)

カーソル位置を変数に格納します。

        Selection.ParagraphFormat.TabStops.Add _
            Position:=posi, Alignment:=stHaichi, _
            Leader:=wdTabLeaderSpaces

変数stHaichiには、「wdAlignTabLeft」「wdAlignTabRight」など、タブの種類が入ります。
「Leader」はタブのリーダーです。「wdTabLeaderSpaces」はスペースで、既定値のためなくてもOKです。

ほかの種類はこちらです。
破線 wdTabLeaderDashes
点線 wdTabLeaderDots
中点 wdTabLeaderMiddleDot
太線 wdTabLeaderHeavy
二重線 wdTabLeaderLines

【Word VBA/マクロ】検索の基本構文

検索構文をまとめています。
他の基本構文はこちら
よく使用するコードはこちら

Sub 検索基本構文_Range方式()
    Dim rng As Range
    
    '文書の先頭位置にrngをセット
    Set rng = ActiveDocument.Range(0, 0)

    With rng.Find
        .Text = "検索ワード"
        
        '検索条件に書式を含める場合
        .Font
        .Frame
        .Highlight = False
        .ParagraphFormat
        .Style = "スタイル名"
        
        '検索オプションを指定
        'Trueにしたいオプション以外、記述不要
        '(Section.Findを用いる場合、Falseの記述も必要)
        .MatchCase = False '大文字と小文字を区別
        .MatchWholeWord = False '完全一致の単語を検索
        .MatchByte = False '半角と全角を区別
        '↓Trueにできるのは1つのみ
        .MatchAllWordForms = False
        .MatchSoundsLike = False 'あいまい検索(英)
        .MatchWildcards = False 'ワイルドカードを使用
        .MatchFuzzy = False 'あいまい検索(日)
        '↑ 
    
    '◆単純な置換を行う場合◆
        .Replacement.Text = "" '置換後の文字列
        .Replacement.Font.Bold = False '置換後の書式
        .Execute Replace:=wdReplaceAll 'すべて置換
     End With 

    '◆置換では対処できない複雑な処理を行う場合◆
    With rng
        Do While .Find.Execute = True            
           '処理内容を書く            
           'rngの範囲を検索結果の末尾に変更
           '(検索方法によっては別の範囲にrngを再定義)
           .SetRange .End, .End            
        Loop
    End With
End Sub
Sub 検索の基本構文_Selection方式()
    '文字カーソルを文頭に移動。
    Selection.StartOf Unit:=wdStory, Extend:=wdMove
    
    With Selection.Find
         .ClearFormatting '「.Format」がFalseの時は不要
        .Format = False
        .Text = "検索ワード"
        .Replacement.Text = ""
        .Replacement.Font
        .Forward = True

        '文書の末尾に到達した場合の設定
        .Wrap = wdFindContinue
        
        '次の4行は、Trueにする項目を最後に書く。
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = False
        
        '◆単純な置換の場合◆
        .Execute Replace:=wdReplaceAll
        
        '◆複雑な処理の場合◆
        With Selection
            Do While .Find.Execute = True
                '処理内容を書く
                .Collapse wdCollapseEnd '処理内容によっては省略可
            Loop
        End With
    End With
End Sub
Sub 選択範囲のみ処理する基本構文()
  Dim selRng As Range, rngInRange As Range
  Dim keyWord As String
  keyWord = "検索キーワード"
   
  Set selRng = Selection.Range
  Set rngInRange = selRng.Duplicate
  
    '選択範囲の文字列と検索ワードが一致している場合
    If selRng.Text = keyWord Then
        '処理内容を書く
        '例:検査ワードをBold指定
        selRng.Font.Bold = True
    Else
        With selRng.Find
          .ClearFormatting '「.Format」がFalseの時は不要
          .Text = keyWord
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindStop
          .Format = False '書式を扱う場合はTrue
          .MatchCase = False
          .MatchWholeWord = False
          .MatchByte = False
          .MatchAllWordForms = False
          .MatchSoundsLike = False
          .MatchWildcards = False
          .MatchFuzzy = False
          
          '◆複雑な処理の場合◆
          Do While .Execute
              If selRng.InRange(rngInRange) Then
                    '処理内容を書く
                    
                    selRng.SetRange selRng.End, selRng.End
                    Stop
              Else
                Exit Do
              End If
          Loop
        End With
    End If
End Sub

【Word VBA/マクロ】アクティブページの図形のグループ化

サンプルコードでできること

カーソルのあるページのオートシェイプ等の図をすべてグループ化します。

Sub アクティブページの図形を選択とグループ化()    
    If Selection.Type = 8 Then
        MsgBox "図形が選択されています。図を選択しないで実行してください"
        Exit Sub
    End If
    
    アクティブページの図形を選択
        
        If Selection.ShapeRange.Count <= 1 Then
            MsgBox "図が1つのみのため、グループ化できません"
            Exit Sub
        End If    
    Selection.ShapeRange.Group
End Sub

Sub アクティブページの図形を選択()  
  Dim shp As Shape
  ActiveWindow.View.Type = wdPrintView
  If Selection.Type = wdSelectionShape Then
    MsgBox "図形が選択されています。"
    Exit Sub
  End If
 
  For Each shp In ActiveDocument.Bookmarks("\Page").Range.ShapeRange
      shp.Select Replace:=False
  Next shp 
End Sub

コードの説明

  For Each shp In ActiveDocument.Bookmarks("\Page").Range.ShapeRange
      shp.Select Replace:=False
  Next shp 

For Exch構文を用いて、ページ内の図形を1つずつ選択します。

【Word VBA/マクロ】ウィンドウ左に表示

サンプルコードでできること

ウインドウを画面の左側に表示します。

Sub ウインドウ左表示()
    Dim dWidth As Long, dHeight As Long
    
    With ActiveWindow
        .WindowState = wdWindowStateMaximize
        
        dWidth = .Width
        dHeight = .Height
        
        .WindowState = wdWindowStateNormal
        
        .Width = dWidth / 2
        .Height = dHeight
        
        .Left = 0
        .Top = 0
    End With

End Sub

コードの説明

    With ActiveWindow
        .WindowState = wdWindowStateMaximize
        
        dWidth = .Width
        dHeight = .Height

       '省略
    End With

ウインドウを最大化して、幅と高さを変数に格納します。

        .Width = dWidth / 2

「dWidth / 2」でウインドウを画面半分の幅にします。

【Word VBA/マクロ】文書内すべてのフォント設定

サンプルコードでできること

本文、ヘッダー・フッター、オートシェイプ、スマートアート等のフォントをArialに設定します。

Sub AllFontArial()
    Dim stFont As String
    stFont = "Arial"
    
    Dim b As Boolean
    b = FontChangeMsg(stFont)
    If b = False Then Exit Sub
    FontSet_Body stFont
    FontSet_HeaderFooter stFont
    FontSetAutoshape stFont
End Sub

Private Sub FontSet_Body(fontName As String)
    ActiveDocument.Content.Font.Name = fontName
End Sub

Private Sub FontSet_HeaderFooter(fontName As String)
Dim sec As Section
Dim hdr As HeaderFooter
Dim ftr As HeaderFooter
Dim shp As Shape
Dim gpshp As Shape
    For Each sec In ActiveDocument.Sections
        For Each hdr In sec.Headers
            hdr.Range.Font.Name = fontName                
                For Each shp In hdr.Shapes
                    If shp.Type = msoGroup Then
                        For Each gpshp In shp.GroupItems
                          If gpshp.TextFrame.HasText Then
                              gpshp.TextFrame.TextRange.Font.Name = fontName
                          End If
                        Next
                    End If
                    If shp.TextFrame.HasText Then
                        With shp.TextFrame.TextRange.Font
                            .Name = fontName                            
                        End With
                    End If
                Next
        Next        
        For Each ftr In sec.Footers
            ftr.Range.Font.Name = fontName
        Next
    Next
End Sub

Private Sub FontSetAutoshape(fontName As String)
    Dim shp As Shape
    Dim gpshp As Shape
    Dim saNode As SmartArtNode
    Dim saNodes As SmartArtNodes
    Dim inlShp As InlineShape
    Dim canShp As Shape
    
    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoGroup Then 'グループ化されている場合
            For Each gpshp In shp.GroupItems
              If gpshp.TextFrame.HasText Then
                  gpshp.TextFrame.TextRange.Font.Name = fontName
              End If
            Next
        ElseIf shp.Type = msoSmartArt Then 'スマートアートの場合
            For Each saNode In shp.SmartArt.Nodes
                With saNode
                    If .TextFrame2.HasText Then
                        saNode.TextFrame2.TextRange.Font.Name = fontName
                    End If
                End With
            Next
        ElseIf shp.Type = msoCanvas Then '描画キャンバスの場合
            For Each canShp In shp.CanvasItems
                If canShp.Type = msoGroup Then
                    For Each gpshp In canShp.GroupItems
                        If gpshp.TextFrame.HasText Then
                            gpshp.TextFrame.TextRange.Font.Name = fontName
                        End If
                    Next
                Else
                    If canShp.TextFrame.HasText Then
                        canShp.TextFrame.TextRange.Font.Name = fontName
                    End If
                End If
            Next        
        Else
            If shp.TextFrame.HasText Then '上記以外の場合
                With shp.TextFrame.TextRange.Font
                    .Name = fontName
                End With
            End If
        End If
    Next
    
    '行内のスマートアート
    For Each inlShp In ActiveDocument.InlineShapes
        If inlShp.Type = wdInlineShapeSmartArt Then
            For Each saNode In inlShp.SmartArt.Nodes
                With saNode
                    If .TextFrame2.HasText Then
                        saNode.TextFrame2.TextRange.Font.Name = fontName
                    End If
                End With
            Next
        End If
    Next        
End Sub

コードの説明

本文、ヘッダー・フッター、図の処理は、3つのプロシージャに分けています。

【Word VBA/マクロ】表の罫線の太さ変更

サンプルコードできること

文書内すべての表の罫線0.5ptを0.75ptに変更します。

Sub 罫線の太さ変更()
    Dim bd As Border
    Dim tbl As Table
    Dim cel As Cell
    Application.ScreenUpdating = False
    For Each tbl In ActiveDocument.Tables
        For Each cel In tbl.Range.Cells
            For Each bd In cel.Borders
                With bd
                    If .LineWidth = wdLineWidth050pt Then
                        .LineWidth = wdLineWidth075pt
                    End If
                End With
            Next
        Next
    Next
    Application.ScreenUpdating = True
End Sub

コードの説明

For Eachを3つ用いて、表ごと、セルごと、セル内の罫線ごとに処理しています。

【Word VBA/マクロ】表の配置を中央に設定/表内の表の配置を中央に設定

サンプルコードでできること

文書内の表すべての上下配置を中央に設定します。

コードの内容

For Each構文を用いて、文書内の表すべての上下配置を変更しています。

Sub 表の配置を中央揃えに設定()
    Dim tbl As Table
    For Each tbl In ActiveDocument.Tables
        tbl.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    Next
End Sub



サンプルコードでできること

表内の表の上下配置を中央に設定します。

コードの内容

「For Each tbl In ActiveDocument.Tables」で表ごとに、「For Each subTbl In tbl.Tables」で表内の表ごとに上下配置を変更しています。

Sub 表内表の配置を中央揃えに設定()
    Dim tbl As Table
    Dim subTbl As Table
    For Each tbl In ActiveDocument.Tables
        For Each subTbl In tbl.Tables
            subTbl.Range.Cells.VerticalAlignment = _
                 wdCellAlignVerticalCenter
        Next
    Next
End Sub