通过Excel VBA偶尔停止PowerPoint图表交互

时间:2018-03-05 10:41:23

标签: excel vba excel-vba powerpoint powerpoint-vba

我对ChartData财产有一些问题,我希望你们能提供帮助。简短的版本是,当运行代码时,它通常会在尝试随机打开/关闭ChartData属性时停止。然后我点击继续,它继续运行。

较长的版本,我正在尝试使用可在服务器上找到的几个工作簿中的大约30张幻灯片更新PowerPoint演示文稿。当我运行代码时,它通常在与图表后面的工作簿交互时停止。

我已尝试使用/不使用引用,事先激活或选择ChartData父对象,但我仍然得到相同的错误:

  

方法工作簿对象chartdata失败

Method workbook object chartdata failed

我是否遗漏了某些东西,或者Excel没有说话"正确" PowerPoint?

现在代码:

Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public ppApp As PowerPoint.Application
Public ppPres As PowerPoint.Presentation
Public ppSlide As PowerPoint.Slide
Public ppShape As PowerPoint.Shape
Public ppChart As PowerPoint.Chart
Public ppChartData As PowerPoint.ChartData
Public ppSeries As PowerPoint.Series

Public Wb as Workbook

'...

Sub PPT_Slide2 ()

Dim sPathWb As String
Dim Wb_Chart As Workbook
Dim Ws_Chart As Worksheet

sPathWb = ThisWorkbook.Path & "\[server folder partial address]" 

Application.DisplayAlerts = False
    Set Wb = Workbooks.Open(sPathWb & "\file.xlsm")
Application.DisplayAlerts = True


For Each ppShape In ppSlide.Shapes
    'ppShape.Select
    If ppShape.Name = "Chart 1" Then

        Set ppChart = ppShape.Chart
        Set ppChartData = ppChart.ChartData
        ppShape.Chart.ChartData.Activate
        Set Wb_Chart = ppChartData.Workbook
        Set Ws_Chart = Wb_Chart.Worksheets(1)
        Ws_Chart.Activate

        Range(Range("A1"), Range("A1").SpecialCells(xlCellTypeLastCell)).ClearContents

        Windows(Wb.Name).Activate
        Wb.Sheets("Financial").Activate

        Application.CutCopyMode = False

        Set Rng = Range(Range("E2"), Range("E2").End(xlToRight))
        Rng.Copy

        ppApp.Activate
        Ws_Chart.Activate
        Range("B1").PasteSpecial xlPasteValues

        Windows(Wb.Name).Activate

        Cells(Rows.Count, "A").End(xlUp).End(xlUp).Activate

        Set Rng = Range(ActiveCell, ActiveCell.Offset(14, 0))
        Rng.Copy

        ppApp.Activate
        Ws_Chart.Activate
        Range("A2").PasteSpecial xlPasteValues
        Application.CutCopyMode = False

        Windows(Wb.Name).Activate

        Cells(Rows.Count, "E").End(xlUp).End(xlUp).Activate
        Set Rng = Range(ActiveCell, ActiveCell.Offset(14, 0).End(xlToRight))

        Rng.Copy

        ppApp.Activate
        Ws_Chart.Activate
        Ws_Chart.Range("B2").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        ppShape.Chart.ChartData.Workbook.Close True

        '--> refreshing the chart here; 
        'for whatever reason the PowerPoint Chart does not show the newly added values 
        'unless in debug mode or if I set a wait time

        With ppChart
            .ChartData.Activate
            .Refresh
            Sleep 100
            .ChartData.Workbook.Close
        End With

    End If
Next

Wb.Close False

Set Wb = Nothing
Set Ws_Chart = Nothing
Set Wb_Chart = Nothing
Set ppChartData = Nothing
Set ppChart = Nothing

End Sub

0 个答案:

没有答案