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

Question

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

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

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

Answer 1

我仍然感到惊讶的是，许多PasteSpecial选项在剪贴板或PowerPoint中都不可用。我认为使用不同的方法可以解决这个问题。而不是：

PPSlide.Shapes.PasteSpecial ppPasteOLEObject

尝试使用此方法：

PPSlide.Parent.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

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

PowerPoint结果

Excel表格示例

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

• PasteSourceFormatting
• PasteDestinationTheme
• PasteAsEmbedded
• PasteExcelTableSourceFormatting
• PasteExcelTableDestinationTableStyle

与许多其他方法相比，这种方法没有得到充分记录。 Application.CommandBars property reference没有提及ExecuteMso方法，我在这里找到了一些相关信息（以及之前我曾看过一次或两次的SO）：

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

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

Answer 2

另一种将数据从Excel传送到没有VBA代码的PPT幻灯片的方法也可以。

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

第1步：复制Excel数据/表

第2步：转到Power point幻灯片

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

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

步骤5：点击确定

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

希望这个选项有所帮助。

谢谢， Gourish

Answer 3

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

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

我假设您希望将此代码保留为后期绑定，但是您的代码中也有一些部分会引起问题，因为您将其视为早期绑定编写。

此外，我有一个与此主题相关的YouTube视频，因此，如果您想进行更复杂的粘贴或使用多个Excel Range，请随时观看该系列。

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

第一部分：声明变量

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

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

'Dim Excel Variables
 Dim ExcRng As Range

第二部分：创建新的Powerpoint实例

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

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

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

这会将新的演示文稿添加到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.

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

这将为要复制的Excel范围设置参考。

'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) '<<< 10 means OLEOBJECT

第五部分：对齐形状

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

'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

现在，这就是您的代码的外观：

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