Question

我正在通过Excel编写宏，这将帮助我执行以下步骤。目前，我停留在步骤3。

'在Excel工作表中复制特定的单元格
'打开现有的Powerpoint演示文稿（其中有四张幻灯片，每张幻灯片上都有大约6-7张图表，其基础数据必须替换为复制的单元格）
'选择幻灯片1上的特定图表
'通过右键单击“编辑数据”来打开特定图表的基础数据
在弹出的工作表中选择单元格，并将其替换为在步骤1中从Excel复制的数据。

目前，我的问题出在第3步，在该步骤中我无法在PowerPoint中选择任何图表。我还要感谢所有可以对步骤4和步骤5有所帮助的指南。

我当前的代码如下：

Sub MyMacroRätt()

'Marks and copies a cell block in my Excel file 

    ActiveSheet.Range("R55", "T75").Select
    Selection.Copy

'Open an existing PowerPoint file 

        Dim PPT As PowerPoint.Application
        Set PPT = New PowerPoint.Application
        PPT.Visible = True
        PPT.Presentations.Open Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm"

        Dim PPPres As PowerPoint.Presentation
        Set PPPres = PPT.ActivePresentation
        Dim pslide As PowerPoint.Slide
        Dim pchart As PowerPoint.Chart

'Mark the first chart on the first slide 
        With ActiveWindow.Selection.ShapeRange(1)

            If .HasChart = True Then

'Open Edit Data-sheet for selected chart 
        Chart.ActivateChartDataWindow

        End If
        End With

'Select existing data i Edit Data-sheet and replace with copied data from Excel 

End Sub

Answer 1

下面的宏打开指定的PowerPoint文件，激活ChartData，以便打开其工作簿，将指定的数据复制到工作簿的第一个工作表中（从A2开始），然后关闭它。您需要相应地更改目标单元格（A2）。

Option Explicit

Sub MyMacroRätt()

    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptShape As PowerPoint.Shape
    Dim rngCopyFrom As Range

    Set rngCopyFrom = ActiveSheet.Range("R55", "T75")

    Set pptApp = New PowerPoint.Application
    pptApp.Visible = True

    Set pptPres = pptApp.Presentations.Open(Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm")

    With pptPres.Slides(1) 'first slide
        For Each pptShape In .Shapes
            If pptShape.HasChart Then 'first chart
                Exit For
            End If
        Next pptShape
        If Not pptShape Is Nothing Then
            pptShape.Chart.ChartData.Activate
            With rngCopyFrom
                pptShape.Chart.ChartData.Workbook.Worksheets(1).Range("a2") _
                    .Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
            pptShape.Chart.ChartData.Workbook.Close
        End If
    End With

    Set pptApp = Nothing
    Set pptPres = Nothing
    Set pptShape = Nothing
    Set rngCopyFrom = Nothing

End Sub

编辑

要选择要更新的图表，例如第二张图表，请尝试以下操作...

Option Explicit

Sub MyMacroRätt()

    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptShape As PowerPoint.Shape
    Dim rngCopyFrom As Range
    Dim ChartNum As Long
    Dim ChartIndex As Long

    ChartNum = 2 'second chart

    Set rngCopyFrom = ActiveSheet.Range("R55", "T75")

    Set pptApp = New PowerPoint.Application
    pptApp.Visible = True

    Set pptPres = pptApp.Presentations.Open(Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm")

    With pptPres.Slides(1) 'first slide
        ChartIndex = 0
        For Each pptShape In .Shapes
            If pptShape.HasChart Then
                ChartIndex = ChartIndex + 1
                If ChartIndex = ChartNum Then
                    Exit For
                End If
            End If
        Next pptShape
        If Not pptShape Is Nothing Then
            pptShape.Chart.ChartData.Activate
            With rngCopyFrom
                pptShape.Chart.ChartData.Workbook.Worksheets(1).Range("a2") _
                    .Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
            pptShape.Chart.ChartData.Workbook.Close
        End If
    End With

    Set pptApp = Nothing
    Set pptPres = Nothing
    Set pptShape = Nothing
    Set rngCopyFrom = Nothing

End Sub

Answer 2

感谢Domenic，它确实有效！

现在，我想为我的PPT中的更多图表再次重复此操作，因此在第一步“设置rngCopyFrom = ActiveSheet.Range（“ R55”，“ T75”）中，我将更改应从Excel复制的单元格块但是，当我重复发送的整个代码时，我也想将所选图表更改为PPT第一张幻灯片中的“第二张图表”。您对如何调整此部分有想法吗？幻灯片1中的图表，并将新的单元格粘贴到该图表工作表中？

        If pptShape.HasChart Then 'first chart

换句话说，我想要一个代码选择幻灯片1上的第二张图表，另一个代码选择幻灯片1上的第三张图表，另一个代码选择幻灯片1 .....上的第四张图表，依此类推。每张幻灯片上总共有8张图表，总共4张幻灯片上有需要更新其数据的图表。

我想使用VBA将从Excel复制的单元格粘贴到PPT演示文稿中的图表数据中

2 个答案: