【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つのプロシージャに分けています。