Я хочу вставить скопированный блок ячеек из Excel в данные диаграммы в презентации PPT с использованием VBA

Question

Я пишу макрос через Excel, который поможет мне выполнить следующие шаги. В настоящее время я застрял на шаге 3.

1. 'Копировать определенный блок в листе Excel
2. 'Открыть существующую презентацию Powerpoint (которая состоит из четырех слайдов с примерно 6-7 диаграммами на каждом слайде, базовые данные которых должны быть заменены скопированным блоком ячеек)
3. 'Выберите конкретный график на слайде 1
4. 'Откройте базовые данные конкретного графика, щелкнув правой кнопкой мыши на «Редактировать данные»
5. Выберите ячейку на всплывающем листе и замените его данными, скопированными из Excel на шаге 1

Моя проблема в данный момент заключается в шаге 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

Спасибо, Доменик, это действительно сработало!

Теперь я хочу повторить это еще раз для большего количества диаграмм в моем PPT, поэтому на первом шаге "Set rngCopyFrom = ActiveSheet.Range (" R55 "," T75 ") я изменю блок ячеек, который должен бытьСкопировано из Excel. Однако, когда я повторю весь отправленный вами код, я также хочу изменить выбранную диаграмму на ВТОРОЙ ДИАГРАММ на первом слайде в PPT. У вас есть идеи о том, как я могу настроить этот раздел, чтобы он вместо этоговыбирает вторую диаграмму на слайде 1 и вставляет новый блок ячеек в эту таблицу?

        If pptShape.HasChart Then 'first chart

Другими словами, я хочу код, который выбирает вторую диаграмму на слайде 1, другой код, который выбираеттретий график на слайде 1, другой код, который выбирает четвертый график на слайде 1 ..... и т. д. Всего у меня есть 8 графиков на каждом слайде, и в целом у меня есть четыре слайда с графиками, данные которых должны бытьобновлено.

Answer 2

Следующий макрос открывает указанный файл 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