Change_Font_JA2MSGothic_EN2Arial.bas

Public Sub makeFontMSgothicandArial()
    Const nameFont As String = "ＭＳ ゴシック"
    Const newFont As String = "Arial"

    Dim col As Collection
    Dim shp As Shape

    Set col = New Collection

    Call getColShapeFromPresentation(col)   
    Call getColShapeFromSlideMaster(col)  

    For Each shp In col      
        Call changeFont(shp, nameFont) 
        Call changeFont(shp, newFont)
    Next

End Sub


Private Sub changeFont(ByRef shp As Shape, ByVal nameFont As String)
    Dim s As Shape
    If shp.HasTextFrame Then
        Call setFontName(shp.TextFrame.textRange.Font, nameFont)
    ElseIf shp.HasSmartArt Then
        For Each s In shp.GroupItems
            Call changeFont(s, nameFont)
        Next
    ElseIf shp.HasTable Then
        Dim c As Cell, r As Row
        For Each r In shp.Table.Rows
            For Each c In r.Cells
                Call changeFont(c.Shape, nameFont)
            Next
        Next
    ElseIf shp.HasChart Then
        Call setFontName(shp.Chart.Format.TextFrame2.textRange.Font, nameFont)
        For Each s In shp.Chart.Shapes
            Call changeFont(s, nameFont)
        Next
    End If
    
End Sub

Private Sub setFontName(ByRef f As Object, ByVal nameFont As String)
    If TypeName(f) = "Font" Or TypeName(f) = "Font2" Then
        f.Name = nameFont
        f.NameFarEast = nameFont
        f.NameAscii = nameFont
        f.NameComplexScript = nameFont
    Else
        Debug.Print "font type:", TypeName(f)
    End If
End Sub


Public Sub getColShapeFromPresentation(ByRef col As Collection)
    Dim sld As Slide
    Dim shp As Shape
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            Call putShapeIntoCol(shp, col)
        Next
    Next
End Sub

Public Sub getColShapeFromSlide(ByRef col As Collection)
    Dim shp As Shape

    If ActiveWindow.Selection.Type < ppSelectionSlides Then Exit Sub
    For Each shp In ActiveWindow.Selection.SlideRange.Shapes
        Call putShapeIntoCol(shp, col)
    Next
End Sub


Public Sub putShapeIntoCol(ByRef shp As Shape, ByRef col As Collection)
    Dim s As Shape
    If shp.Type <> msoGroup Then
        col.Add shp
    Else
        For Each s In shp.GroupItems
            Call putShapeIntoCol(s, col)
        Next
    End If
End Sub


Public Sub getColShapeFromSlideMaster(ByRef col As Collection)
    Dim shp As Shape
    Dim d As Design
    For Each d In ActivePresentation.Designs
        For Each shp In d.SlideMaster.Shapes.Placeholders
            Call putShapeIntoCol(shp, col)
        Next
    Next
End Sub