uk

Sub ReplaceFontInSlides()
    Dim slide As slide
    Dim shape As shape
    Dim textRange As TextRange
    Dim paragraph As TextRange
    Dim run As TextRange
    
    Dim oldFont As String
    Dim newFont As String
    
    ' 置き換えるフォント名を指定
    oldFont = "Noto Sans Symbols"
    newFont = "MS Pゴシック"
    
    ' すべてのスライドをループ
    For Each slide In ActivePresentation.Slides
        ' スライド内のすべてのシェイプをループ
        For Each shape In slide.Shapes
            ' テキストを含むシェイプのみ処理
            If shape.HasTextFrame Then
                If shape.TextFrame.HasText Then
                    Set textRange = shape.TextFrame.TextRange
                    
                    ' テキスト内のすべての段落をループ
                    For Each paragraph In textRange.Paragraphs
                        ' 段落内の各テキストラン（文字の連続）をループ
                        For Each run In paragraph.Runs
                            ' 指定したフォントが適用されているか確認
                            If run.Font.Name = oldFont Then
                                ' フォントを新しいフォントに変更
                                run.Font.Name = newFont
                            End If
                        Next run
                    Next paragraph
                End If
            End If
        Next shape
    Next slide
    
    MsgBox "フォントの置換が完了しました！", vbInformation
End Sub