Question

我有一个名为“ KillSpecificSlide”的宏代码用于电源点。这些代码在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

这保存在名为BOX.pptm的PPT的模块1中。我想通过浏览来为其他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

为其他PPT运行Powerpoint宏代码

1 个答案: