How to select which PowerPoint to edit in Excel VBA? - vba

Question

I am building a report where users will take tables from Excel and paste them into a PowerPoint. Since I won't know what the users will name the PowerPoint, I am giving them two options. If the one they want is not open, they will open it. What I am having trouble is if the one they want is already open, how can I have them select it? This is what I have so far:
Dim ans As Integer
Dim pptName As String
Dim ppt As PowerPoint.Application
Dim myPres As PowerPoint.Presentation
Dim arr() As String
Dim j As Variant
ans = MsgBox("Is the PowerPoint already open?", vbYesNo + vbQuestion)
If ans = vbYes Then
For Each myPres in ppt.Presentations
Redim Preserve arr(j)
arr(j) = myPres.Name
j = j + 1
Next
'How to use the names of all the current ppts in the array and let a user select which one from that list
Set myPres = ppt.Presentations(1)
Else
MsgBox ("Please choose PowerPoint to open.")
'openDialog is a function I have already created
pptName = openDialog()
Set myPres = ppt.Presentations.Open(pptName)
End If
Any suggestions would be greatly appreciated!

Answer 1

It's a little long, But I've included the code in the regular Module, and also the User_Form.
Code Module
Option Explicit
Public PPTFileName As String '<-- defined as Public, will get it from the User_Form's ListBox
Sub SelectPPTPresentation()
' === this loop through all open PowerPoint Presentations is using Late Binding
' === to avoid future problems when working with multiple Office Versions
Dim ppApp As Object
Dim ppPres As Object
Dim ObjPres As Object
If MsgBox("Is the PowerPoint already open?", vbYesNo + vbQuestion) = vbYes Then
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If ppApp Is Nothing Then
MsgBox "No PowerPoint is open!"
Else
If ppApp.Presentations.Count > 0 Then ' check that at least 1 Presentation is open
For Each ObjPres In ppApp.Presentations ' loop through all open presnetations (
UserForm1.OpenPPPres_LB.AddItem ObjPres.FullName '<-- add their full names to the User_Form ListBox
Next ObjPres
End If
End If
UserForm1.Show '<-- show the User_Form with the ListBox of all open PPT presentations
' loop through all open presnetations (check Full Name: Path and name)
For Each ObjPres In ppApp.Presentations
If StrComp(ObjPres.FullName, PPTFileName, vbTextCompare) = 0 Then
Set ppPres = ObjPres ' <-- set the current PPT pres to the selected Item from the ListBox
Exit For
End If
Next ObjPres
MsgBox "Selected Presentation is " & ppPres.Name ' <-- just for confirmation >> show Name (without Path)
Else ' <-- you will need to modify this section to fit the upper section
' MsgBox ("Please choose PowerPoint to open.")
' 'openDialog is a function I have already created
' pptName = openDialog()
' Set myPres = ppt.Presentations.Open(pptName)
'
End If
End Sub
User_Form Code the event is under the "OpenPPPres_LB" ListBox DblClick event:
Private Sub OpenPPPres_LB_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
For i = 0 To OpenPPPres_LB.ListCount - 1
If OpenPPPres_LB.Selected(i) Then
PPTFileName = OpenPPPres_LB.List(i) ' <-- save the PPT filename
Exit For
End If
Next i
Unload UserForm1
End Sub
Screen-shot of the User_Form populated with the current Open Presentations: