VBA 从 Excel 粘贴到 PPT 作为嵌入表格

Question

我正在使用下面的代码，它可以很好地粘贴为图片。我花了很多时间（比如 15 个小时）在互联网上寻找和啄食才将这段代码组合在一起（我对 VBA 知之甚少......我记录宏）。我只是被要求将其粘贴为嵌入式表格。我不知道如何在 VBA 中执行此操作。我很感激任何人可以提供的帮助？

这将从工作表的 250 多行中拉出每一行以及标题行。 你会注意到我使用“'”“停用”了相当多行代码，但我把它们留在了模块中（因为我在 VBA 方面很无能，但绝望了）

我真的很感激任何帮助。

Sub CopyRangeToPresentation() 
'Slides for 
'Variables 
    Dim PP As PowerPoint.Application 
    Dim PPpres As PowerPoint.Presentation 
    Dim PPslide As PowerPoint.Slide 
    Dim SlideTitle As String 
    Dim lRow As Long 
    Dim i As Integer 
'Fider 
    lRow = Cells.Find(What:="*", _ 
    After:=Range("A1"), _ 
    LookAt:=xlPart, _ 
    LookIn:=xlFormulas, _ 
    SearchOrder:=xlByRows, _ 
    searchdirection:=xlPrevious, _ 
    MatchCase:=False).row 
'New presentation 
    Set PP = New PowerPoint.Application 
    Set PPpres = PP.Presentations.Add 
    Set PP = GetObject(, "PowerPoint.Application") 
    PP.Visible = 1 
    For i = 1 To lRow 
'New slide 
    Set PPslide = PPpres.Slides.Add(i, ppLayoutBlank) 
    PP.ActiveWindow.ViewType = ppViewSlide 
    PPpres.PageSetup.SlideSize = ppSlideSizeOnScreen 
    PP.ActiveWindow.WindowState = ppWindowMaximized 
    PPslide.Select 
'Copy 
    Sheets("Sheet1").Range("A1:K1").CopyPicture _ 
'Range("A1").Copy 
'PPslide.Shapes.Paste 
'PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
'PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 
    With PPslide.Shapes.Paste(1) 
    .Left = 0 
    .Top = 2.55 * 72 ' 72 points=1in 
    .Height = 72 * 3.39 
    .Width = 72 * 9.8 
    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
    End With 
    Application.CutCopyMode = False 
    Sheets("Sheet1").Range(Cells(i, 1), Cells(i, 11)).CopyPicture _ 
    Appearance:=xlScreen, Format:=xlPicture 
'Paste 
' PPslide.Shapes.Paste.Select 
' PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
' PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 
    With PPslide.Shapes.Paste(1) 
    .Left = 0 
    .Top = 2.92 * 72 ' 72 points=1in 
    .Height = 72 * 3.39 
    .Width = 72 * 9.8 
    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
    End With 
'Title 
    Next i 
'Memory 
    PP.Activate 
    Set PPslide = Nothing 
    Set PPpres = Nothing 
    Set PP = Nothing 
End Sub

我使用了粘贴的代码，它可以很好地作为图片粘贴到 PPT 中，但现在我需要它作为嵌入表格粘贴，但不知道如何实现这一点。

Answer 1

使用

ppPasteOLEObject

作为第二个参数粘贴为 OLEObject（嵌入的 Excel 表格）。

    Set PP = GetObject(, "PowerPoint.Application")
    ' Sheets("Sheet1").Range("A1:K1").Select
    Sheets("Sheet1").Range("A1:K1").Copy ' copy Excel range with format
    Set PPslide = PP.ActivePresentation.Slides.Add(1, 12)  ' ppLayoutBlank=12
    PPslide.Shapes.PasteSpecial 10 'ppPasteOLEObject=10 ' paste as OLEObject
    With PPslide.Shapes(PPslide.Shapes.Count)
        .Height = 72 * 3.39
        .Width = 72 * 9.8
        .Left = PP.ActivePresentation.PageSetup.SlideWidth / 2 - .Width / 2
        .Top = PP.ActivePresentation.PageSetup.SlideHeight / 2 - .Height / 2
    End With
    Application.CutCopyMode = False