使用数组从 Excel 更新 Powerpoint 图表

Question

Set PPT = GetMePowerpoint
PPT.Visible = True
Set PPres = PPT.presentations.Open(PPTFilePathAndName)
With PPres

For i = UBound(varTbl) To LBound(varTbl) Step -1
    Set PSlide = .slides(varSht(i))
    For j = UBound(varTbl(i)) To LBound(varTbl(i)) Step -1
        With PSlide

            Set pTempSlide = .Duplicate
            With pTempSlide
                .Name = "Sheet" & i & "_" & varSht(i) & "_" & j 'Give a name to slide

                If varSht(i) = "Scape" Then

                    'check the count of columns in table for doughnut chart
                    'if columns are less than 6 then delete the extra doughnut charts
                    m = 0
                    For x = 1 To .Shapes.count
                        If .Shapes(x).Type = msoChart Then
                            m = m + 1
                        End If
                    Next x

                    For x = .Shapes.count To 1 Step -1
                        If .Shapes(x).Type = msoChart Then
                            If m > UBound(varMktReady(i)(j), 2) - 1 Then .Shapes(x).Delete: m = m - 1
                            If m = UBound(varMktReady(i)(j), 2) - 1 Then Exit For
                        End If
                    Next x
                End If
            End With
            Set pTempSlide = Nothing
        End With
    Next j
    Set PSlide = Nothing
Next i

ReDim tempArr(1 To 1)
ReDim tempArr1(1 To 1)


For i = LBound(varTbl) To UBound(varTbl)
    For j = LBound(varTbl(i)) To UBound(varTbl(i))
        Set PSlide = .slides("Sheet" & i & "_" & varSht(i) & "_" & j)
        With PSlide
            .Shapes.Title.TextFrame.TextRange.Text = varTbl(i)(j)

            CCount = 2
            For k = 1 To .Shapes.count
                '   determine if shape is a Chart
                If .Shapes(k).Type = msoChart Then
                    Set pShape = PSlide.Shapes(k)
                    Set pChart = pShape.Chart

                    '   check if Office version is 2010
                    If Application.Version <= "14.0" Then pChart.ChartData.Activate
                    Set pData = pChart.ChartData.Workbook.Worksheets(1)
                    lngPlotBy = pChart.PlotBy

                    '   clear source range
                    pData.Cells.Clear

                    'check for Doughnut chart
                    With pData

                        If varSht(i) = "Scape" Then
                            tempArr = varMktReady(i)(j)
                            tempArr1 = Application.Index(tempArr, 0, 1)
                            tempArr2 = Application.Index(tempArr, 0, CCount)
                            CCount = CCount + 1

                            '   reset sourcedata range of chart and copy table array
                            'If Application.Version <= "14.0" Then
                                pChart.SetSourceData Source:=.Range(.Cells(3, 1), .Cells(UBound(tempArr1, 1) + 2, 2)).Address(, , , xlExternal), PlotBy:=lngPlotBy
                            'Else
                            '    pChart.SetSourceData Source:=.Range(.Cells(3, 1), .Cells(UBound(tempArr1, 1) + 2, 2)), PlotBy:=lngPlotBy
                            'End If
                            .Range(.Cells(3, 1), .Cells(UBound(tempArr1, 1) + 2, 1)) = tempArr1
                            .Range(.Cells(3, 2), .Cells(UBound(tempArr1, 1) + 2, 2)) = tempArr2
                            .Parent.Close
                            pChart.Refresh
                            WaitSeconds 3
                        Else
                            '   reset sourcedata range of chart and copy table array
                            'If Application.Version <= "14.0" Then
                                pChart.SetSourceData Source:=.Range(.Cells(3, 1), .Cells(UBound(varMktReady(i)(j), 1) + 2, UBound(varMktReady(i)(j), 2))).Address(, , , xlExternal), PlotBy:=lngPlotBy
                            'Else
                            '    pChart.SetSourceData Source:=.Range(.Cells(3, 1), .Cells(UBound(varMktReady(i)(j), 1) + 2, UBound(varMktReady(i)(j), 2))), PlotBy:=lngPlotBy
                            'End If
                            .Range(.Cells(3, 1), .Cells(UBound(varMktReady(i)(j), 1) + 2, UBound(varMktReady(i)(j), 2))) = varMktReady(i)(j)
                            .Parent.Close
                            pChart.Refresh
                            WaitSeconds 3
                        End If
                    End With
                    Set pData = Nothing
                    Set pChart = Nothing
                End If
            Next k
        End With
    Next j
Next i

'.....

Public Sub WaitSeconds(intSeconds As Integer)
  On Error GoTo PROC_ERR

  Dim datTime As Date

  datTime = DateAdd("s", intSeconds, Now)

  Do
    Sleep 100
  Loop Until Now >= datTime

PROC_EXIT:
  Exit Sub

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.WaitSeconds"
  Resume PROC_EXIT
End Sub

我已经在 excel 中编写了上述（sn-p 仅显示 powerpoint 代码部分）代码，该代码从每个工作表（共 4 张）中打开另一个工作簿，将不同的表挑选成锯齿状数组。 然后此代码打开一个具有 4 个差异图表幻灯片的 powerpoint 模板，然后根据 4 个不同工作表的表数组计数复制这些幻灯片。 一旦幻灯片被复制（约 354 张幻灯片），数组就会循环播放并选择每张幻灯片，并将数组中必要的表格数据放入每个图表数据表中。

但问题是，代码需要大量时间（约 1 小时）来更新图表数据表。大多数时候excel崩溃。

当我看到任务管理器时，我发现原因是“自动化”，因为每次激活图表数据并将数组转储到数据表中时，都会创建一个外部 Excel 副本。即使我尝试关闭图表 excel 工作簿，我也可以看到 Excel 进程的多个副本堆积。我尝试了 WAIT、DoEvents 和现在的 SLEEP，但大多数时候 excel 仍然挂起，除非我将睡眠时间增加到 10 秒 - 但这会使图表更新时间过长。

1] 如何加快图表数据的更新速度？ 2] 有没有办法在 powerpoint 图表工作簿中使用命名范围，然后做一个 pastespecial paste:=values ？ 3] 复制粘贴 excel 范围（而不是使用数组）会加快 powerpoint 图表更新速度吗？

任何帮助将不胜感激。

Answer 1

可能是您没有停用图表数据 Excel 对象。
您可能根本不想激活它，而只是直接更改数据表。

.Chart.ChartData.Workbook.sheets(1).Range("A2").Value

将此值设置为数组中的值

这是 2016 年的，但您也可以使用 .Cells。

如果不激活图表数据表，您将不会打开另一个 excel 实例。