Powerpoint循环通过折线图 - 活动X错误

时间:2015-06-24 08:52:52

标签: excel vba powerpoint-vba

我已经制作了一个代码来从excel打开Powerpoint,然后遍历所有幻灯片,找到图表并更改一些列。我有代码进行替换,但不能'似乎循环滑动,因为它抛出一个ActiveX错误429,基本上说没有找到powerpoint:O。

Sub pptDataChange()    

'Define variables of excel
Dim mySheet As Excel.Worksheet

'Define variables to open on PPT
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim sld As Slide
Dim shp As Shape
Dim chrt As Chart

'Copy range from Excel
Set mySheet = ThisWorkbook.Worksheets("Sheet1")

'Create instance of Powerpoint
On Error Resume Next

    'Open Powerpoint with Powerpoint is already opened
    Set PowerPointApp = GetObject(class:="PowerPoint.Application")

    'Clear errors
    Err.Clear

    'If Powerpoint is closed, open Powerpoint
    If PowerPointApp Is Nothing Then
        Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    End If

    'Handle error if Powerpoint isn't installed or not found
    If Err.Number = 429 Then
        MsgBox ("PowerPoint not found, aborting...")
        Exit Sub
    End If

On Error GoTo 0

'Make Powerpoint visible and active
PowerPointApp.Visible = True
PowerPointApp.Activate

'Open Powerpoint Presentation from PATH and set it as the active
PowerPointApp.Presentations.Open ("File.pptx")

For Each sld In ActivePresentation.Slides
    For Each shp in sld
       'Iterate through charts and change data of chart using something like If sld Has.Chart Then ...
Next sld

Exit Sub

我在想的可能是因为ActivePresentation,但我尝试引用myPresentation,但它是一样的。

你能帮忙吗?

1 个答案:

答案 0 :(得分:0)

我明确声明要使用Presentation变量而不是ActivePresentation,这似乎可以解决问题。仅供参考:我还更改了sldshp变量的声明,以明确引用PowerPoint对象库。

Sub pptDataChange()

'Define variables of excel
Dim mySheet As Excel.Worksheet

'Define variables to open on PPT
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim chrt As Chart

'Copy range from Excel
Set mySheet = ThisWorkbook.Worksheets("Sheet1")

'Create instance of Powerpoint
On Error Resume Next

    'Open Powerpoint with Powerpoint is already opened
    Set PowerPointApp = GetObject(class:="PowerPoint.Application")

    'Clear errors
    Err.Clear

    'If Powerpoint is closed, open Powerpoint
    If PowerPointApp Is Nothing Then
        Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
    End If

    'Handle error if Powerpoint isn't installed or not found
    If Err.Number = 429 Then
        MsgBox ("PowerPoint not found, aborting...")
        Exit Sub
    End If

On Error GoTo 0

'Make Powerpoint visible and active
PowerPointApp.Visible = True
PowerPointApp.Activate

'Open Powerpoint Presentation from PATH and set it as the active
Dim pres As PowerPoint.Presentation
Set pres = PowerPointApp.Presentations.Open("File.pptx")

For Each sld In pres.Slides
    For Each shp In sld.Shapes
       'Iterate through charts and change data of chart using something like If sld Has.Chart Then ...
    Next shp
Next sld

End Sub