如何将数据从Excel传输到PowerPoint工作表并更新PowerPoint图表范围?

时间:2016-08-22 15:43:42

标签: vba excel-vba powerpoint-vba excel

我在PowerPoint中创建了一个宏,用于打开Excel工作簿,遍历工作簿中的工作表,创建PowerPoint图表并使用Excel工作表中的数据填充它们。为了说清楚,宏是从PowerPoint运行的。

我现在需要制作数据范围(从Excel传输到Powerpoint工作表时)和PowerPoint图表数据范围是动态的。例如。因为每个Excel工作表范围不同,因此每个PowerPoint图表数据范围都不相同。

以下是我的宏:

    Sub CreateChartAllWKsv3()

    '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
        Dim CurSlide As Slide 'new from update
        Dim LastRow As Long ' 8/22
        Dim LastColumn As Long ' 8/22

    ' 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:\ExcelWorkbook.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 xlWB.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
                    ' 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("Sheet1") 
                    'Clear contents from PowerPoint worksheet
                            pptWorkSheet.UsedRange.ClearContents 'Works
                    'Find Last Row and Column of xlWS
                            LastRow = xlWS.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
                            LastColumn = xlWS.Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column
                    ' Add the data to the PowerPoint workbook.
                            xlWS.Range(Cells(1, 1), xlWS.Cells(LastRow, LastColumn)).Copy 'Fails to past any data on the second worksheet
                            pptWorkSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
                    ' Update PowerPoint workbook chart data reference.
                             'line below didn't work                            
                            pptWorkSheet.ListObjects("Table1").Resize pptWorkSheet.Range("Table1[#All]").Resize(Rows.Count, Columns.Count)

                    ' 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
            xlWB.Close
            'Option to close the excel application
    End Sub

我遇到了两个问题:

  1. xlWS.Range(Cells(1, 1), xlWS.Cells(LastRow, LastColumn)).CopypptWorkSheet.Range("A1").PasteSpecial Paste:=xlPasteValues将数据传输到第一个PowerPoint工作表,但在第二个工作表上失败 - 没有粘贴任何内容。
  2. pptWorkSheet.ListObjects("Table1").Resize pptWorkSheet.Range("Table1[#All]").Resize(Rows.Count, Columns.Count)无法在PowerPoint工作表上调整PowerPoint图表范围。我收到method failed错误。
  3. 修改 我对第一个问题的解决方法是只转移大范围,我的数据永远不会大于使用pptWorkSheet.Range("a1:z100").Value = xlWS.Range("a1:z100").Value

1 个答案:

答案 0 :(得分:0)

很抱歉,但我没有足够的声誉来添加评论。

是否有理由不能使用链接数据?

我目前有一些powerpoint show,它使用excel数据,并且当我在打开时选择更新链接时,只需链接它以获取最新信息。

由于