时间戳

首页 > 解决方案 > 为其他 PPT 运行 Power Point 宏代码

excel - 为其他 PPT 运行 Power Point 宏代码

问题描述

我有一个名为“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

这保存在名为 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

标签： excelvbapowerpoint

解决方案

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

推荐阅读