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

Question

我正在通过Excel编写一个宏，它将帮助我完成以下步骤。目前，我被困在第三步。

1. 在Excel表中复制特定的单元格
2. 打开现有的Powerpoint演示文稿(该演示文稿由四张幻灯片组成，每张幻灯片上大约有6-7张图表，其底层数据必须被复制的单元格替换)
3. ‘在幻灯片1上选择特定图表
4. 通过右键单击“编辑数据”打开特定图表的基础数据
5. 选择弹出的工作表中的单元格，并将其替换为步骤1中从Excel复制的数据。

我目前的问题是在第三步，在那里我无法选择任何图表在我的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

谢谢多梅尼卡，它真的起作用了！

现在，我想再重复一次，以获得更多的图表，所以在第一步"Set rngCopyFrom =ActiveSheet.Range“(”R55“，"T75")中，我将更改应该从Excel复制的单元格块。但是，当我重复您发送的全部代码时，我也希望将选定的图表更改为PPT第一张幻灯片上的第二张图表。您对如何调整这个部分，以便它选择幻灯片1中的第二个图表，并将新的单元格块粘贴到图表工作表中，有什么想法吗？

        If pptShape.HasChart Then 'first chart

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