如何使用 VBA 动态引用 PowerPoint 幻灯片

How to dynamically reference PowerPoint slides using VBA

我有一个 written/compiled 宏,它可以打开 Excel 文件、创建 PowerPoint 图表并使用 Excel 文件中工作表中的数据填充图表工作表。

我正在尝试更改宏以循环遍历 Excel 文件的工作表并且:

  1. 为每个工作表创建一个 PowerPoint 幻灯片和图表
  2. 使用 Excel 文件中工作表中的数据填充 PowerPoint 图表

目前,当我 运行 宏时,第一个 PowerPoint 图表和幻灯片已正确创建。第二张幻灯片是为 Excel 文件的第二张工作表创建的,但未正确创建 PowerPoint 图表。我正在测试宏的工作簿有两个工作表。

动态引用每张新 PowerPoint 幻灯片的正确方法是什么?到目前为止,我一直在使用:

Set pptWorkSheet = pptWorkBook.Worksheets(ActivePresentation.Slides.Count) 'sorta works-changed 8/19

当我转到调试器时它说 ActivePresentation.Slides.Count = 2 所以我不确定为什么它不将数据传输到第二个 PowerPoint 图表。

我在这里也可能没有正确引用 Excel 文件工作表:

pptWorkSheet.Range("a2:b5").Value = xlWB.ActiveSheet.Range("a2:b5").Value

下面是完整的宏:

Sub CreateChartAllWKs()

'Create variables
    Dim myChart As Chart
    Dim pptChartData As ChartData
    Dim pptWorkBook As Excel.Workbook
    Dim pptWorkSheet As Excel.Worksheet
    Dim xlApp As Excel.Application
    Dim xlWB As Workbook
    Dim xlWS As Worksheet  

' Create new excel instance and open relevant workbook
    Set xlApp = New Excel.Application
    xlApp.Visible = True 'Make Excel visable
    Set xlWB = xlApp.Workbooks.Open("C:\filepath\ExcelData.xlsm", True, False)  'Open relevant workbook

'Loop through each worksheet in xlWB and transfer data to new pptWorkBook and
'create new PowerPoint chart
    For Each xlWS In ActiveWorkbook.Worksheets

        'Add a new slide where we will create the PowerPoint worksheet and chart
            ActivePresentation.Slides.Add ActivePresentation.Slides.Count + 1, ppLayoutText
            ActiveWindow.View.GotoSlide ActivePresentation.Slides.Count
            Set activeSlide = ActivePresentation.Slides(ActivePresentation.Slides.Count)

        ' Create the chart and set a reference to the chart data.
            Set myChart = activeSlide.Shapes.AddChart.Chart 'changed 8/19
            Set pptChartData = myChart.ChartData

        ' Set the PowerPoint Workbook and Worksheet references.
            Set pptWorkBook = pptChartData.Workbook
            Set pptWorkSheet = pptWorkBook.Worksheets(ActivePresentation.Slides.Count) 'sorta works-changed 8/19

        ' Add the data to the PowerPoint workbook.
            pptWorkSheet.ListObjects("Table1").Resize pptWorkSheet.Range("A1:B5")
            pptWorkSheet.Range("Table1[[#Headers],[Series 1]]").Value = "Items"
            pptWorkSheet.Range("a2:b5").Value = xlWB.ActiveSheet.Range("a2:b5").Value 'transfer data from ExcelWB to pptWorkSheet (i.e. the PowerPoint workbook)

        ' Apply styles to the chart.
            With myChart
                .ChartStyle = 4
                .ApplyLayout 4
                .ClearToMatchStyle
            End With

        ' Add the axis title.
            With myChart.Axes(xlValue)
                .HasTitle = True
                .AxisTitle.Text = "Units" 
            End With

        'Apply data labels
            myChart.ApplyDataLabels
   Next xlWS

' Clean up the references.
    Set pptWorkSheet = Nothing
' pptWorkBook.Application.Quit
    Set pptWorkBook = Nothing
    Set pptChartData = Nothing
    Set myChart = Nothing
'Clean up Excel references.
    Set xlApp = Nothing
'Option to close excel workbook
    'ExcelWB.Close
End Sub

我认为您 运行 遇到的问题是 PowerPoint 和 Excel 如何存储幻灯片编号和工作 sheet 编号。 PowerPoint 至少有 3 个与幻灯片不同的属性,包括 "Slide IDs"、"Slide Indexes" 和 "Slide Numbers"。它们各不相同,当您尝试引用它们时会让事情变得很痛苦。我喜欢做的实际上是在创建幻灯片时设置幻灯片的引用:

Set CurSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutText)

这种方式在您创建幻灯片时就有了对它的引用。

此外,我发现使用数字作为作品sheet 引用也会导致问题,因为如果您引用第 5 部作品sheet,它可能不是第 5 部作品sheet全部。您必须查看 Excel 的 VBA 编辑器,以了解 sheet 得到了什么参考。但是,如果您能够引用作品sheet 名称,例如"Sheet1"、"Sheet2"、"OtherWorksheet" 等,您可以使事情变得容易得多。如果你创建一个名为“5”的 sheet 然后调用工作 sheet with.

Set ws = ActiveWorkBook.WorkSheets(5)

不行。您需要使用

Set ws = ActiveWorkBook.Worksheets("5")

希望这是有道理的。这部分不是必需的,但如果您 运行 进入问题,它会使调试变得容易得多。我建议这样做的方法不在我下面的代码中,因为我没有你的工作簿。

Set PPtWorkSheet = pptWorkBook.Worksheets("Sheet" & CurSlide.SlideIndex) 

我重写了您的几行代码,并且能够正常运行。但是我没有你的工作簿的副本,所以我不能 100% 确定这会奏效。如果您仍然无法从幻灯片索引中引用作品sheet,请考虑更改工作簿上的作品sheet 名称。

修改后的代码如下,如有任何问题,请告诉我。

Sub CreateChartAllWKs()

'Create variables
        Dim myChart As Chart
        Dim pptChartData As ChartData
        Dim pptWorkBook As Excel.Workbook
        Dim pptWorkSheet As Excel.Worksheet
        Dim xlApp As Excel.Application
        Dim xlWB As Excel.Workbook
        Dim xlWS As Excel.Worksheet
        Dim CurSlide As Slide 'new from update

' Create new excel instance and open relevant workbook
        Set xlApp = New Excel.Application
        xlApp.Visible = True 'Make Excel visable
        Set xlWB = xlApp.Workbooks.Open("C:\filepath\ExcelData.xlsm", True, False)  'Open relevant workbook

'Loop through each worksheet in xlWB and transfer data to new pptWorkBook and
'create new PowerPoint chart
        For Each xlWS In ActiveWorkbook.Worksheets

                'Add a new slide where we will create the PowerPoint worksheet and chart
                        'Set CurSlide = ActivePresentation.Slides.Add ActivePresentation.Slides.Count + 1, ppLayoutText
                        ActiveWindow.View.GotoSlide ActivePresentation.Slides.Count
'This is my recommendation
                        Set CurSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutText)

                ' Create the chart and set a reference to the chart data.
                        Set myChart = CurSlide.Shapes.AddChart.Chart 'changed 8/19
                        Set pptChartData = myChart.ChartData

                ' Set the PowerPoint Workbook and Worksheet references.
                        Set pptWorkBook = pptChartData.Workbook
                        Set pptWorkSheet = pptWorkBook.Worksheets(CurSlide.SlideIndex) 'From Update

                ' Add the data to the PowerPoint workbook.
                        pptWorkSheet.ListObjects("Table1").Resize pptWorkSheet.Range("A1:B5")
                        pptWorkSheet.Range("Table1[[#Headers],[Series 1]]").Value = "Items"
                        pptWorkSheet.Range("a2:b5").Value = xlWB.ActiveSheet.Range("a2:b5").Value 'transfer data from ExcelWB to pptWorkSheet (i.e. the PowerPoint workbook)

                ' Apply styles to the chart.
                        With myChart
                                .ChartStyle = 4
                                .ApplyLayout 4
                                .ClearToMatchStyle
                        End With

                ' Add the axis title.
                        With myChart.Axes(xlValue)
                                .HasTitle = True
                                .AxisTitle.Text = "Units"
                        End With

                'Apply data labels
                        myChart.ApplyDataLabels
     Next xlWS

' Clean up the references.
        Set pptWorkSheet = Nothing
' pptWorkBook.Application.Quit
        Set pptWorkBook = Nothing
        Set pptChartData = Nothing
        Set myChart = Nothing
'Clean up Excel references.
        Set xlApp = Nothing
'Option to close excel workbook
        'ExcelWB.Close
End Sub