如何選擇在Excel VBA中編輯哪個PowerPoint？

Question

我正在構建一份報告，用戶將從Excel中獲取表格並將其粘貼到PowerPoint中。由於我不知道用戶將如何命名PowerPoint，我給了他們兩個選擇。如果他們想要的那個沒有打開，他們會打開它。我遇到麻煩的是，如果他們想要的那個已經打開了，我該如何讓他們選擇它？這是我到目前爲止有：

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 

任何建議，將不勝感激！

Answer 1

這有點長，但我已將代碼包含在常規模塊中，也包含User_Form。

代碼模塊

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代碼事件是根據 「OpenPPPres_LB」 列表框DblClick事件：

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 

的User_Form填充的屏幕截圖目前的Open Presentations：