我正在Excel中构建一个VBA宏,用于将Excel范围和Excel图表复制到PowerPoint中。为此,我想打开一个现有的演示文稿(pptName)。
很可能我已经打开了演示文稿,以及其他演示文稿集合。
代码目标: 查找PowerPoint是否已打开;如果已打开,则检查pptName。 如果pptName已经打开,则继续执行脚本,否则打开pptName。
问题: 我似乎无法让它使用已经打开的pptName。 它要么打开第二个新实例的演示文稿,要么使用最近使用的演示文稿,通常不是我要编辑的特定文稿。
代码: Dim ppApp作为PowerPoint.Application Dim ppSlide作为PowerPoint.Slide
尝试修正,仍然不正确:
很可能我已经打开了演示文稿,以及其他演示文稿集合。
代码目标: 查找PowerPoint是否已打开;如果已打开,则检查pptName。 如果pptName已经打开,则继续执行脚本,否则打开pptName。
问题: 我似乎无法让它使用已经打开的pptName。 它要么打开第二个新实例的演示文稿,要么使用最近使用的演示文稿,通常不是我要编辑的特定文稿。
代码: Dim ppApp作为PowerPoint.Application Dim ppSlide作为PowerPoint.Slide
Dim pptName As String
Dim CurrentlyOpenPresentation As Presentation
pptName = "MonthlyPerformanceReport"
'Look for existing instance
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Create new instance if no instance exists
If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
'Add a presentation if none exists
'If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
'If ppt is open, check for pptName. If pptName is already open then progress, otherwise open pptName
If ppApp.Presentations.Count > 0 Then
For Each CurrentlyOpenPresentation In ppApp.Presentations
If CurrentlyOpenPresentation.FullName = pptName & ".pptx" Then GoTo ProgressWithScript
Next CurrentlyOpenPresentation
ppApp.Presentations.Open Filename:=SheetLocation & "\" & pptName & ".pptx"
End If
ProgressWithScript:
'Open Presentation specified by pptName variable
If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Open Filename:=SheetLocation & "\" & pptName & ".pptx"
'If ppApp.Presentations.Count > 0 Then ppApp.Presentations.Open Filename:=SheetLocation & "\" & pptName & ".pptx"
'Application.DisplayAlerts = False
尝试修正,仍然不正确:
If ppApp.Presentations.Count > 0 _
Then
For Each CurrentlyOpenPresentation In ppApp.Presentations
If CurrentlyOpenPresentation.FullName = pptName _
Then IsOpen = True
If CurrentlyOpenPresentation.FullName = pptName _
Then ppApp.ActiveWindow.View.GotoSlide ppApp.Presentations(pptName).Slides.Count
If IsOpen = True Then GoTo ProgressWithScript
Next CurrentlyOpenPresentation
'Else: ppApp.Presentations.Open Filename:=SheetLocation & "\" & pptName & ".pptm"
End If
IsOpen = False
If IsOpen = False _
Then ppApp.Presentations.Open Filename:=SheetLocation & "\" & pptName & ".pptm"