2017-04-25 7 views
0

사용자가 Excel에서 표를 가져와 PowerPoint에 붙여 넣을 보고서를 작성 중입니다. 사용자가 PowerPoint의 이름을 알지 못하므로 두 가지 옵션을 제공하고 있습니다. 원하는 사람이 열리지 않으면 열립니다. 내가 곤경에 처하게되는 것은 그들이 원하는 것이 이미 열려 있다면 어떻게 그들을 선택할 수있게 할 것인가? 이것은 내가 지금까지 가지고있는 것입니다 :Excel VBA에서 편집 할 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 

어떤 제안을 주시면 감사하겠습니다!

+0

루프가 열려있는 모든 프리젠 테이션 불구하고, 그들의 이름을 얻고, 사용 하나 –

+0

감사합니다 선택할 수 있습니다! 열려있는 모든 PowerPoint 이름의 배열을 포함하는 코드를 편집했습니다. 사용자가 그 중 하나를 선택하게하려면 어떻게해야합니까? – BH57

+1

배열로 채워진 ListBox가있는 작은 user_form을 만들고 하나는 ListBox에서 특정 항목을 선택하여 프레젠테이션을 설정합니다. –

답변

0

약간 길지만 정규 모듈에는 코드가 포함되어 있으며 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 이벤트 : 채워진 User_Form의

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 

스크린 샷 현재 오픈 프리젠 테이션 :

enter image description here