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中编写了上面的代码（片段仅显示了powerpoint代码部分）代码，从每个工作表（共4页）中打开另一个工作簿，将不同的表格选择为锯齿状数组。然后这段代码打开一个powerpoint模板，它有4个差异图表幻灯片，然后根据4个不同工作表的表格数量复制这些幻灯片。一旦幻灯片重复（~354张幻灯片），就会循环播放数组并选择每张幻灯片，并将数组中必要的表格数据放入每个图表数据表中。

然而问题是，代码需要花费大量时间（约1小时）来更新图表数据表。大多数时候擅长崩溃。

当我看到任务经理时，我发现原因是＆＃34;自动化＆＃34;每当图表数据被激活并且数组被转储到数据表中时，就会创建一个外部excel副本。即使我试图关闭图表excel工作簿，我也可以看到excel进程的多个副本堆积起来。我尝试了WAIT，DoEvents并且现在已经休眠，但是大多数时候excel都会挂起，除非我将睡眠时间增加到10秒 - 但这会使图表更新时间过长。

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

任何帮助都将非常受欢迎。

Answer 1

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

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

将此值设置为数组中的值

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

如果不激活chartdata表，则不会打开另一个excel实例。

使用数组

1 个答案: