パワーポイント用文字列入れ替えマクロ

PowerPointのテキストボックスのテキストを入れ替えるマクロ（VBA）

Sub 文字列の差し替え()

    '作業用動的配列
    Dim moji() As TextRange
    '元文字列リスト
    mojilist1 = Array("文字1", "文字2", "文字3")
    '差し替え用文字列リスト
    mojilist2 = Array("差替1", "差替2", "差替3")

    i = 0
    '元文字列サーチループ
    For Each ml In mojilist1
        'アクティブなスライドにあるシェイプをサーチ
        For Each sh In ActiveWindow.Selection.SlideRange.Shapes
            '見つかったシェイプはテキストボックスか？
            If sh.Type = msoTextBox Then
                'テキストの内容は元文字列と一致するか？
                If ml = sh.TextFrame.TextRange.Text Then
                    '作業用配列要素を追加
                    ReDim Preserve moji(i)
                    '見つかったオブジェクトを格納
                    moji(i) = sh.TextFrame.TextRange
                    i = i + 1
                End If
            End If
        Next sh
    Next ml

    '文字列が見つからなかった場合の処理
    'エラーをエスケープ
    On Error Resume Next
    '作業用配列の要素数を調べる
    ubmoji = UBound(moji)
    'エラー番号とメッセージを退避
    errNumber = Err.Number
    errDescription = Err.Description
    'エラーを戻す
    On Error GoTo 0
    'エラー処理
    If errNumber <> 0 Then
        'エラーNo9（配列がない）か？
        If errNumber = 9 Then
            MsgBox("文字列が見つかりません")
        Else
            'それ以外のエラー
            MsgBox(errNumber & " : " & errDescription)
        End If
        Exit Sub
    End If

    '文字列差し替え
    For i = 0 To ubmoji
        'オブジェクトのテキストメンバに差し替え用文字列を代入
        moji(i).Text = mojilist2(i)
    Next i

End Sub

参考：
不要なものを削除するマクロ
http://msdn.microsoft.com/ja-jp/library/office/ee814734.aspx

アクティブスライド上のすべての文字列を取得するマクロ
https://www.relief.jp/docs/017829.html

On Error Resume Nextの正しい使い方
http://scripting.cocolog-nifty.com/blog/2006/12/on_error_resume_d841.html