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

来源：该代码是克里斯·纽曼（Chris Newman）的作品的组合：“ Copy & Paste An Excel Range Into PowerPoint With VBA”和“ Copy & Paste Multiple Excel Ranges To Separate PowerPoint Slides With VBA”，但经过修改后，您向现有的PowerPoint文件添加了路径。

Answer 2

我只更改了路径，没有别的，这就是我看到的错误。

对此表示歉意，但我不是VBA专家。enter image description here

Answer 3

这是我看到的新错误，如果我删除了if条件。enter image description here

如何打开现有的Powerpoint并粘贴Excel范围

3 个答案: