Как открыть существующий PowerPoint и вставить диапазон Excel

Question

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

Я попытался найти его в Интернете и создалчто-то, но это не работает.Макрос работает, но я не вижу никакого вывода.Пожалуйста помоги.Ниже приведен код, над которым я работаю:

Sub Excelrangetopowerpoint()

Dim rng As Range
Dim Powerpointapp As PowerPoint.Application
Dim myPresentation As PowerPoint.Application
Dim DestinationPPT As String
Dim myShape As Object
Dim myslide As Object


Set rng = Worksheets("regions").Range("B1:N18")

On Error Resume Next

Set Powerpointapp = CreateObject("Powerpoint.application")
DestinationPPT = ("C:\Users\OLX-Admin\Dropbox (Corporate Finance)\Naspers Monthly Reporting\Prep for call\From teams\FY2019\OLX Group Monthly Report_Sep'18_Macro.pptx")
Powerpointapp.Presentations.Open (DestinationPPT)


If Err.Number = 429 Then
MsgBox "Powerpoint could not be found.aborting."
Exit Sub

On Error GoTo 0
Application.ScreenUpdating = False

rng.Copy

Set myslide = PowerPoint.ActivePresentation.Slides(4)

myslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = myslide.Shapes(myslide.Shapes.Count)

myShape.Left = 152
myShape.Top = 152

Powerpointapp.Visible = True
Powerpointapp.Activate

activation.CutCopyMode = False

End If

End Sub

Answer 1

Это должно работать.В вашем измененном коде были некоторые недостающие части.

Обратите внимание, что если презентация уже открыта, этот код откроет существующий файл в режиме «только для чтения» ... (поэтому все равно,файл powerpoint уже открыт или нет).

Код VBA

Sub Excelrangetopowerpoint()
Dim rng As Range
Dim Powerpointapp As Object
Dim myPresentation As Object
Dim DestinationPPT As String
Dim myShape As Object
Dim mySlide As Object

'Copy Range from Excel
Set rng = Worksheets("regions").Range("B1:N18")

'Create an Instance of PowerPoint
On Error Resume Next

'Set your destination path for the powerpoint presentation and open the file
Set Powerpointapp = CreateObject("Powerpoint.application")
DestinationPPT = ("C:\Test\My Powerpoint\Presentation1.pptx")
Powerpointapp.Presentations.Open (DestinationPPT)

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
    MsgBox "Powerpoint could not be found.aborting."
    Exit Sub
End If
On Error GoTo 0

'Optimize Code
Application.ScreenUpdating = False

'Set my current Powerpoint window as activated
Set myPresentation = Powerpointapp.ActivePresentation

'Set which slide to paste into
Set mySlide = myPresentation.Slides(4)

'Copy Excel Range
rng.Copy

'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

'Set position:
myShape.Left = 152
myShape.Top = 152

'Make PowerPoint Visible and Active
Powerpointapp.Visible = True
Powerpointapp.Activate

'Clear The Clipboard
Application.CutCopyMode = False

End Sub

Источник: Код представляет собой комбинацию работы Криса Ньюмана: "Копирование и вставка диапазона Excel в PowerPoint с VBA"&" Копирование и вставка нескольких диапазонов Excel для разделения слайдов PowerPoint с VBA", но с изменением, которое вы добавляете путь к уже существующему файлу PowerPoint.