Question

我有一个宏，允许用户选择一个新PPT打开或从已经打开的PPT中选择，然后将excel中的表粘贴到该特定PPT中。我遇到的问题是，如果用户打开了多个PPT并且它不是最近查看/可见的文件，则表格不会粘贴到正确的区域。

有没有办法让PPT在粘贴前显得可见或活跃？我尝试了以下但它似乎不起作用。

Dim pptName As String
Dim ppt As PowerPoint.Application
Dim myPres As PowerPoint.Presentation
Dim slds As PowerPoint.Slides
Dim sld As PowerPoint.slide
Dim shp As PowerPoint.Shape
Dim tbl As Table
Dim lRow As Long
Dim lCol As Long
Dim main As CustomLayout
Dim supp As CustomLayout

Set ppt = CreateObject("PowerPoint.Application")

Dim arr() As String
Dim j As Variant

ans = MsgBox("Is the PowerPoint already open?", vbYesNo)

If ans = vbYes Then
    For Each myPres In ppt.Presentations
        ReDim Preserve arr(j)
        arr(j) = myPres.Name
        Debug.Print arr(j)
        j = j + 1
    Next
    DoEvents

    nws.Columns("A:A").Clear

    nws.Range("A1:A" & j) = WorksheetFunction.Transpose(arr())

    wb.Names("Array").RefersTo = "=Array!$A$1:$A$" & j

    Application.Wait (3000)

    'This is where user selects from the currently open PPTs
    With New SetPPT
        .Show
        If Not .Cancelled Then
            pptName = .SelectedFile
            'Application.Wait (3000)
            Debug.Print pptName
            Set myPres = ppt.Presentations(pptName)
            myPres.Application.Visible = True
        End If
    End With

    Unload SetPPT

Else
    MsgBox ("Please choose PowerPoint to open.")
    pptName = openDialog()
    Set myPres = ppt.Presentations.Open(pptName)
End If

myPres.Application.Visible = True

Answer 1

我明白了！我将代码更改为以下内容，包括DocumentWindow并激活它，解决了这个问题。

Dim pptName As String
Dim ppt As PowerPoint.Application
Dim myPres As PowerPoint.Presentation
Dim slds As PowerPoint.Slides
Dim sld As PowerPoint.slide
Dim shp As PowerPoint.Shape
Dim tbl As Table
Dim lRow As Long
Dim lCol As Long
Dim main As CustomLayout
Dim supp As CustomLayout
Dim wnd as DocumentWindow

Set ppt = CreateObject("PowerPoint.Application")

Dim arr() As String
Dim j As Variant

ans = MsgBox("Is the PowerPoint already open?", vbYesNo)

If ans = vbYes Then
    For Each myPres In ppt.Presentations
        ReDim Preserve arr(j)
        arr(j) = myPres.Name
        Debug.Print arr(j)
        j = j + 1
    Next
DoEvents

nws.Columns("A:A").Clear

nws.Range("A1:A" & j) = WorksheetFunction.Transpose(arr())

wb.Names("Array").RefersTo = "=Array!$A$1:$A$" & j

Application.Wait (3000)

'This is where user selects from the currently open PPTs
With New SetPPT
    .Show
    If Not .Cancelled Then
        pptName = .SelectedFile
        'Application.Wait (3000)
        Debug.Print pptName
        Set myPres = ppt.Presentations(pptName)
        Set wnd = myPres.Windows(1)
        wnd.Activate
    End If
End With

Unload SetPPT

Else
    MsgBox ("Please choose PowerPoint to open.")
    pptName = openDialog()
    Set myPres = ppt.Presentations.Open(pptName)
End If

myPres.Application.Visible = True

当多个打开时，使特定的PowerPoint可见/活动？

1 个答案: