vba - Excel のマクロを使用してオーディオ ppt 内のテキストを検索して置換する

Question

エクセルからパワーポイントの単語を検索して置換し、パワーポイントを保存するプロジェクトがあります。私のコードは正常に動作しています。しかし、ppt に mp3 がある場合、エラーが発生します。コードを見て、どのような変更を行うべきか教えてください。

          Sub pptopen()

    Dim a  As Integer
    For a = 2 To 4

   Dim pptApp As PowerPoint.Application
   Dim pptPres As PowerPoint.Presentation
   Dim pptSlide As PowerPoint.Slide
   Dim i As Integer, strString As String
       Set pptApp = CreateObject("PowerPoint.Application")
       Set pptPres = pptApp.Presentations.Add(msoTrue) ' create a new presentation

       Set pptPres = pptApp.Presentations.Open("D:\BirminghamAL.pptx")
       Dim oSld As Slide
       Dim oTxtRng As TextRange
       Dim oTmpRng As TextRange
       Dim strWhatReplace As String, strReplaceText As String

        ' write find text
       strWhatReplace = "Birmingham"
        ' write change text
       strReplaceText = Cells(a, 1).Value

        ' go during each slides
       For Each oSld In pptPres.Slides
            ' go during each shapes and textRanges
           For Each oshp In oSld.Shapes
           If oshp.Type = 14 Or oshp.Type = 17 Then
                ' replace in TextFrame
               Set oTxtRng = oshp.TextFrame.TextRange
               Set oTmpRng = oTxtRng.Replace( _
               FindWhat:=strWhatReplace, _
               Replacewhat:=strReplaceText, _
               WholeWords:=True)
               End If


               Do While Not oTmpRng Is Nothing

                   Set oTxtRng = oTxtRng.Characters _
                   (oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)
                   Set oTmpRng = oTxtRng.Replace( _
                   FindWhat:=strWhatReplace, _
                   Replacewhat:=strReplaceText, _
                   WholeWords:=True)

               Loop
           Next oshp
       Next oSld
       Dim strWhatReplace1 As String, strReplaceText1 As String

        ' write find text
       strWhatReplace1 = "AL"
        ' write change text
       strReplaceText1 = Cells(a, 2).Value

        ' go during each slides
       For Each oSld In pptPres.Slides
            ' go during each shapes and textRanges
           For Each oshp In oSld.Shapes
                 If oshp.Type = 14 Or oshp.Type = 17 Then
                ' replace in TextFrame
               Set oTxtRng = oshp.TextFrame.TextRange
               Set oTmpRng = oTxtRng.Replace( _
               FindWhat:=strWhatReplace1, _
               Replacewhat:=strReplaceText1, _
               WholeWords:=True)
                 End If
               Do While Not oTmpRng Is Nothing

                   Set oTxtRng = oTxtRng.Characters _
                   (oTmpRng.Start + oTmpRng.Length, oTxtRng.Length)
                   Set oTmpRng = oTxtRng.Replace( _
                   FindWhat:=strWhatReplace1, _
                   Replacewhat:=strReplaceText1, _
                   WholeWords:=True)

               Loop
           Next oshp
       Next oSld

      pptPres.SaveAs ("D:\change\" & strReplaceText & "." & strReplaceText1 & ".pptx")

       Next a

   End Sub