从Excel中如何在不切换焦点的情况下更改活动的PowerPoint演示文稿?

时间:2016-12-01 07:36:17

标签: excel vba powerpoint

我使用宏来从Excel将对象导出到PowerPoint。我可以选择要导出的当前打开的演示文稿。但是,当我切换演示时,是否有办法停止从Excel切换到PowerPoint的焦点?我的代码如下:

Function SetActivePresentation(Filename As String) As Boolean

    Dim i As Integer

    ' This just checks if PowerPoint is loaded - not needed for the question
    If Me.Load = False Then
        SetActivePresentation = False
    End If

    ' Loop through the PowerPoint windows
    For i = 1 To Me.pPowerpoint.Windows.Count
        If Me.pPowerpoint.Windows(i).Presentation.name = Filename Then
            Me.pPowerpoint.Windows(i).Activate
            Exit For
        End If
    Next i

    SetActivePresentation = True

End Function

这是类中的pPowerPoint方法:

Public pPowerpoint As Object

Public Property Get PowerPoint() As Object
    PowerPoint = pPowerpoint
End Property

最后我的加载功能:

Function Load() As Boolean

    On Error Resume Next

    ' Set the PowerPoint object
    Set pPowerpoint = GetObject(Class:="PowerPoint.Application")

    ' Handle if the PowerPoint Application is not found
    If Err.Number = 429 Then
        GoTo ErrorHandler
    End If

    Load = True

    Exit Function

ErrorHandler:

    Load = False

End Function

然后从我的代码中的其他地方开始,我可以通过以这种方式For Each slide In PowerPoint.pPowerpoint.ActivePresentation.Slides循环PowerPoint幻灯片来导出Excel对象,其中PowerPoint是我上面引用的PowerPoint类。

1 个答案:

答案 0 :(得分:0)

有点混淆 ..更改活动的PowerPoint演示文稿而不切换焦点.. 。但是从讨论的评论中可以看出,真正的问题是导出 Excel对象而没有焦点在Powerpoint上。要解决此问题,您可以避免使用ActivePresentation对象。怎么样?一个简单的解决方案是使用全局变量..

此代码如下所示:

'Global variables
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide

'searching for presentation (function/sub)
For i = 1 To Me.pPowerpoint.Windows.Count
    If Me.pPowerpoint.Windows(i).Presentation.name = Filename Then
        'dont activate! Me.pPowerpoint.Windows(i).Activate
        Set pptPres = Me.pPowerpoint.Windows(i).Presentation
        Exit For
    End If
Next i

'copy object "Char 1" at "Sheet1"
'by accessing the global variable (other function/sub)
Set objChart = Worksheets("Sheet1").ChartObjects("Chart 1").Chart
objChart.ChartArea.Copy
Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
pptSlide.Shapes.Paste