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

2019年7月20日

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

 

参考:
不要なものを削除するマクロ

アクティブスライド上のすべての文字列を取得するマクロ

On Error Resume Nextの正しい使い方

開発VBA

Posted by ikaken