vba 如何将粘贴数据范围从 Excel 复制到幻灯片

How to Copy paste data range from Excel to powerpoint slide

提问by user3793224

I am trying to prepare code to copy and paste excel data range from excel sheet to powerpoint slide but I am able to paste images only.

我正在尝试准备代码来复制和粘贴 Excel 数据范围，从 excel 表格到 powerpoint 幻灯片，但我只能粘贴图像。

Please help with the suitable code. The code I am using is as follows:

请帮助提供合适的代码。我使用的代码如下：

Sub WorkbooktoPowerPoint()

    Dim pp As Object
    Dim PPPres As Object
    Dim PPSlide As Object
    Dim Rng As Range

    Set pp = CreateObject("PowerPoint.Application")
    Set PPPres = pp.Presentations.Add
    pp.Visible = True
    Set Rng = ActiveSheet.Range("B1:J31")

    Rng.Copy

    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)

    PPSlide.Shapes.PasteSpecial ppPasteOLEObject
    PPSlide.Shapes(1).Select
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignTops, True
    pp.ActiveWindow.Selection.ShapeRange.Top = 65
    pp.ActiveWindow.Selection.ShapeRange.Left = 7.2
    pp.ActiveWindow.Selection.ShapeRange.Width = 700

    pp.Activate
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set pp = Nothing

End Sub

回答by David Zemens

It still surprises me that many of the PasteSpecialoptions are not available form the clipboard or in PowerPoint generally. I think there is a way around this using a different method. Instead of:

令我惊讶的是，许多PasteSpecial选项通常无法从剪贴板或 PowerPoint 中使用。我认为有一种方法可以使用不同的方法来解决这个问题。代替：

PPSlide.Shapes.PasteSpecial ppPasteOLEObject

Try using this method:

尝试使用此方法：

PPSlide.Parent.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

I am not certain of the correct idMsoargument to use but I would start with that, it looks like it works the way I would expect it to:

我不确定idMso要使用的正确参数，但我会从这个开始，它看起来像我期望的那样工作：

PowerPoint Result

PowerPoint 结果

Excel Table Example

Excel表格示例

If not, there are several others that might be worth checking:

如果没有，还有其他几个可能值得检查：

• PasteSourceFormatting
• PasteDestinationTheme
• PasteAsEmbedded
• PasteExcelTableSourceFormatting
• PasteExcelTableDestinationTableStyle

• 粘贴源格式
• 粘贴目的地主题
• 粘贴嵌入
• PasteExcelTableSourceFormatting
• PasteExcelTableDestinationTableStyle

This method is not as well-documented compared to many other methods. The Application.CommandBarsproperty referencehas nary a mention of the ExecuteMsomethod, which I found some information about here (and on SO where I have seen it used once or twice before):

与许多其他方法相比，这种方法没有被充分记录。该Application.CommandBars属性参考具有进制一提ExecuteMso方法，该方法我发现一些信息关于在这里（和SO其中我看到之前所使用的一次或两次）：

The full list of idMsoparameters to explore, which come as part of a rather large executable for use with fluent ribbon UI design, current for Office 2013 I believe:

要探索的idMso参数的完整列表，它们是一个相当大的可执行文件的一部分，用于流畅的功能区 UI 设计，我相信当前适用于 Office 2013：

http://www.microsoft.com/en-us/download/details.aspx?id=727

http://www.microsoft.com/en-us/download/details.aspx?id=727

回答by user3050150

Another method for getting the data from Excel to PPT slides without VBA code also possible.

另一种无需 VBA 代码即可将数据从 Excel 获取到 PPT 幻灯片的方法也是可能的。

Note: save both workbook and PPT file in one location.

注意：将工作簿和 PPT 文件保存在一个位置。

Step 1: Copy excel data / table

第一步：复制excel数据/表格

Step 2: Go to Power point slides

第 2 步：转到 Power point 幻灯片

Step 3: Select Paste special option

第 3 步：选择粘贴特殊选项

Step 4: Select "Paste Link" radio button

第 4 步：选择“粘贴链接”单选按钮

Step 5: Click on Ok

第五步：点击确定

Then save the files then change the data in excel, now it will automatically copy the data based linking the connection.

然后保存文件然后在excel中更改数据，现在它会自动复制基于链接连接的数据。

Hope this option helps.

希望这个选项有帮助。

Thanks, Gourish

谢谢，古利什

回答by areed1192

To take an Excel range and paste it into a PowerPoint Application, requires breaking down the process into a few different parts. Looking at your code, we can break it down to the following components:

要获取 Excel 范围并将其粘贴到 PowerPoint 应用程序中，需要将过程分解为几个不同的部分。查看您的代码，我们可以将其分解为以下组件：

• Create an instance of PowerPoint.
• Create your slide & presentation.
• Create a reference to the range you want to export & then copy it.
• Align the shape to the desired dimensions.
• Finally, release your objects from memory.

• 创建 PowerPoint 的实例。
• 创建您的幻灯片和演示文稿。
• 创建对要导出的范围的引用，然后复制它。
• 将形状与所需尺寸对齐。
• 最后，从内存中释放你的对象。

I am assuming that you want this code left as late-binding, but there are also sections of your code that will cause issues because you are treating it like it was written in early-binding.

我假设您希望此代码保留为 late-binding，但是您的代码中也有一些部分会导致问题，因为您将其视为在 early-binding 中编写的。

Also, I have a YouTube video on this topic, so feel free to watch the series if you want to do a more complicated paste or if you're working with multiple Excel Ranges.

另外，我有一个关于这个主题的 YouTube 视频，所以如果您想要进行更复杂的粘贴或者您正在使用多个 Excel 范围，请随时观看该系列。

Link to Playlist: https://www.youtube.com/playlist?list=PLcFcktZ0wnNlFcSydYb8bI1AclQ4I38VN

播放列表链接：https: //www.youtube.com/playlist?list =PLcFcktZ0wnNlFcSydYb8bI1AclQ4I38VN

SECTION ONE: DECLARE THE VARIABLES

第一节：声明变量

Here we will just create all the variables we need in our script.

在这里，我们将只在脚本中创建我们需要的所有变量。

'Declare PowerPoint Variables
 Dim PPTApp As Object
 Dim PPTPres As Object
 Dim PPTSlide As Object

'Dim Excel Variables
 Dim ExcRng As Range

SECTION TWO: CREATE A NEW INSTANCE OF POWERPOINT

第二部分：创建一个新的 POWERPOINT 实例

This will create a new PowerPoint application, make it visible and make it the active window.

这将创建一个新的 PowerPoint 应用程序，使其可见并使其成为活动窗口。

'Create a new PowerPoint Application and make it visible.
 Set PPTApp = CreateObject("PowerPoint.Application")
     PPTApp.Visible = True
     PPTApp.Activate

SECTION THREE: CREATE A NEW PRESENTATION & SLIDE

第三部分：创建新的演示文稿和幻灯片

This will add a new presentation to the PowerPoint Application, create a new slide in the presentation and set the layout as a blank layout.

这会将新演示文稿添加到 PowerPoint 应用程序，在演示文稿中创建新幻灯片并将布局设置为空白布局。

'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add

'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(1, 12) '<<< THIS 12 MEANS A BLANK LAYOUT.

SECTION FOUR: CREATE A REFERENCE TO THE EXCEL RANGE & COPY IT

第四部分：创建对 Excel 范围的引用并复制它

This will set a reference to our Excel range we want to copy and copy it.

这将设置对我们要复制和复制的 Excel 范围的引用。

'Set a reference to the range
Set ExcRng = Range("B1:J31")

'Copy Range
ExcRng.Copy

SECTION FOUR: PASTE IN SLIDE AS OLEOBJECT

第四部分：在幻灯片中粘贴为 OLEOBJECT

This will paste the range in the slide and set a reference to it.

这会将范围粘贴到幻灯片中并设置对它的引用。

'Paste the range in the slide
 SET PPTShape = PPTSlide.Shapes.PasteSpecial(10) '<<< 10 means OLEOBJECT

SECTION FIVE: ALIGN THE SHAPE

第五部分：对齐形状

This will select the shape and set the dimensions of it.

这将选择形状并设置其尺寸。

'Select the shape.
PPTSlide.Shapes(PPTSlide.Shapes.Count).Select

'Set the Dimensions of the shape.
With PPTApp.ActiveWindow.Selection.ShapeRange
    .Top = 65
    .Left = 7.2
    .Width = 700
End With

SECTION SIX: RELEASE OBJECTS FROM MEMORY

第六节：从内存中释放对象

This will release the objects from memory.

这将从内存中释放对象。

'Erase Objects from memory.
Set PPTApp = Nothing
Set PPTSlide = Nothing
Set PPTShape = Nothing

In full, this is how your code will now look:

完整地说，这就是您的代码现在的样子：

Sub ExportRangeToPowerPoint_Late()

    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim PPTSlide As Object
    Dim PPTShape As Object

    Dim ExcRng As Range

    'Create a new instance of PowerPoint
    Set PPTApp = CreateObject("PowerPoint.Application")
        PPTApp.Visible = True
        PPTApp.Activate

    'Create a new Presentation
    Set PPTPres = PPTApp.Presentations.Add

    'Create a new Slide
    Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)

    'Set a reference to the range
    Set ExcRng = Range("B1:J31")

    'Copy Range
    ExcRng.Copy

    'Paste the range in the slide
    Set PPTShape = PPTSlide.Shapes.PasteSpecial(10)

    'Select the shape.
    PPTSlide.Shapes(PPTSlide.Shapes.Count).Select

    'Set the Dimensions of the shape.
    With PPTApp.ActiveWindow.Selection.ShapeRange
        .Top = 65
        .Left = 7.2
        .Width = 700
    End With

    'Erase Objects from memory.
    Set PPTApp = Nothing
    Set PPTSlide = Nothing
    Set PPTShape = Nothing

End Sub