【Word VBA/マクロ】アクティブページの図のフォント変更

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

表示ページの図のフォントを変更します

コードの説明

  EfontName = "Arial"
  JfontName = "ＭＳ ゴシック"

英数字フォントと日本語フォントを変数に格納します。

  For Each inShp In ActiveDocument.Bookmarks("\Page").Range.InlineShapes
    If inShp.Type = wdInlineShapeSmartArt Then

ページ内の行内の図の中で、スマートアートを判定。
スマートアートのフォント変更を行います。
「.Bookmarks("\Page")」の「\Page"」は、定義済みのブックマークです。
「In ActiveDocument.Bookmarks("\Page".Range)」で、「表示ページ内の範囲で」という意味です。

 For Each shp In ActiveDocument.Bookmarks("\Page").Range.ShapeRange
    If shp.Type = msoGroup Then
　　　'省略 
    ElseIf shp.Type = msoCanvas Then
　　　'省略 
    Else
        With shp.TextFrame
　　　　'省略	
        End With
    End If
  Next shp

前面など、自由に動かせる図形の処理を行います。
グループ化、描画キャンパスの判定を行い、Else以下でそれ以外の図形のフォントを変更します。

Sub SelectShapeFontSet()
'アクティブページのオートシェイプのフォントを変更します
  Dim EfontName As String, JfontName As String
  Dim shp As Shape, gShp As Shape, canShp As Shape
  Dim smtNode As SmartArtNode
  Dim inShp As InlineShape
  
  ActiveWindow.View.Type = wdPrintView
  If Selection.Type = wdSelectionShape Then
    MsgBox "本文領域にカーソルを置いてください"
    Exit Sub
  End If
  
  EfontName = "Arial"
  JfontName = "ＭＳ ゴシック"
  
  ActiveDocument.Bookmarks("\Page").Select

'行内のスマートアートのフォント変更
  For Each inShp In ActiveDocument.Bookmarks("\Page").Range.InlineShapes
    If inShp.Type = wdInlineShapeSmartArt Then
        If inShp.HasSmartArt Then
            For Each smtNode In inShp.SmartArt.AllNodes
                With smtNode.TextFrame2.TextRange.Font
                    .NameFarEast = JfontName
                    .Name = EfontName
                End With
            Next
        End If
    End If
  Next
    
  For Each shp In ActiveDocument.Bookmarks("\Page").Range.ShapeRange
    'グループ化のフォント変更
    If shp.Type = msoGroup Then
        For Each gShp In shp.GroupItems
            With gShp.TextFrame
                If .HasText Then
                    .TextRange.Font.NameFarEast = JfontName
                    .TextRange.Font.Name = EfontName
                End If
            End With
        Next
    
    '描画キャンバス内のフォント変更
    ElseIf shp.Type = msoCanvas Then
        For Each canShp In shp.CanvasItems
            If canShp.Type = msoGroup Then
                For Each gShp In canShp.GroupItems
                    With gShp.TextFrame
                        If .HasText Then
                            .TextRange.Font.NameFarEast = JfontName
                            .TextRange.Font.Name = EfontName
                        End If
                    End With
                Next
            Else
                With canShp.TextFrame
                    If .HasText Then
                        .TextRange.Font.NameFarEast = JfontName
                        .TextRange.Font.Name = EfontName
                    End If
                End With
            End If
        Next
    Else
        '上記以外の図のフォント変更
        With shp.TextFrame
            If .HasText Then
                .TextRange.Font.NameFarEast = JfontName
                .TextRange.Font.Name = EfontName
            End If
        End With
    End If
  Next shp
  Selection.Collapse
End Sub