Запуск макроса кода Power Point для других PPT

Question

У меня есть макрос с именем «KillSpecificSlide» для power point.Этот код запускается за ppt. Если я хочу скопировать тот же код на другой ppt или если я хочу запустить код с одного PPT на некоторые другие PPT, то как это сделать?

Мой код указан ниже:

Sub KillSpecificSlide()
 Dim oSld As Slide
 Dim oShp As Shape
 Dim L As Long
 For L = ActivePresentation.Slides.Count To 1 Step -1
 Set oSld = ActivePresentation.Slides(L)
 For Each oShp In oSld.Shapes
 If oShp.HasTextFrame Then
 Select Case UCase(oShp.TextFrame.TextRange)
 Case Is = "Q4", "CJ"
 oSld.Delete
 Case Else
 'not found
 End Select
 End If
 Next oShp
 Next L
 End Sub

Он сохраняется в модуле 1 PPT с именем BOX.pptm. Я хочу запустить тот же код для других файлов PPT, просматривая его.

Sub PPTTest()
  Dim PPT As Object

  Set PPT = CreateObject("PowerPoint.Application")

  PPT.Presentations.Open "D:\Us\70\Desktop\Shaon\BOD.pptx", , , False

  ' Note that the file name and the module
  ' name are required to path the macro correctly.
  PPT.Run "BOD.pptx!Module1.KillSpecificSlide"

 End Sub

Answer 1

Option Explicit

Sub listOpenPresentations()
    Dim myPpt As Presentation

    Debug.Print "Open ppt's : "; Application.Presentations.Count & vbCrLf
    For Each myPpt In Application.Presentations
        Debug.Print myPpt.Name

        Call Add_and_Delete_Slide(myPpt)

    Next myPpt
End Sub

Sub Add_and_Delete_Slide(locPPT As Presentation)
    Dim pptSlide As Slide
    Dim pptLayout As CustomLayout
    Dim actWindow As Variant

    For Each actWindow In Windows
        If actWindow.Caption = locPPT.Name Then actWindow.Activate
    Next actWindow

    Set pptLayout = ActivePresentation.Slides(1).CustomLayout
    Set pptSlide = ActivePresentation.Slides.AddSlide(2, pptLayout)
    MsgBox "Slide 2 added in """ & ActivePresentation.Name & """"

    ActivePresentation.Slides(2).Delete
    MsgBox "Slide 2 deleted in """ & ActivePresentation.Name & """"
End Sub