如何粘貼表格並將格式從Excel轉換爲Powerpoint？

Question

我想從Excel粘貼表格到Powerpoint並保持源格式（作爲表格）。

目前使用該貼：

'Paste to PowerPoint and position 
mySlide.Shapes.PasteSpecial DataType:=ppPasteSourceFormatting, DisplayAsIcon:=msoFalse 
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count) 

這是以前的工作，但當時我沒有選擇的動態範圍，並從它創建一個表，表中已經存在，此代碼工作正常。

今天我嘗試了很多不同的東西，但是我對VB的瞭解還不足以解決問題。希望有人能成爲我的救星！

整個代碼如下：

Sub ExcelRangeToPowerPoint() 

'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation 

Dim rng As Excel.Range 
Dim PowerPointApp As PowerPoint.Application 
Dim myPresentation As PowerPoint.Presentation 
Dim mySlide As PowerPoint.Slide 
Dim myShapeRange As PowerPoint.Shape 

'Refresh UsedRange (get rid of "Ghost" cells) 
    Worksheets("Task List1").UsedRange 

'Select UsedRange 
    Worksheets("Task List1").UsedRange.Select 


    ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Table1" 
    Range("Table1[#All]").Select 

    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium9" 
    Range("I10").Select 

'Copy Range from Excel 
    Set rng = ActiveSheet.ListObjects(1).Range 

'Create an Instance of PowerPoint 
    On Error Resume Next 

    'Is PowerPoint already opened? 
     Set PowerPointApp = GetObject(class:="PowerPoint.Application") 

    'Clear the error between errors 
     Err.Clear 

    'If PowerPoint is not already open then open PowerPoint 
     If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application") 

    '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 

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

'Create a New Presentation 
    Set myPresentation = PowerPointApp.Presentations.Open("Y:\Projects\VBa\2932 2 Milestones.pptx") 

'Add a slide to the Presentation 
    Set mySlide = myPresentation.Slides.Item(1) 

'Delete Current table from Powerpoint 
    myPresentation.Slides(1).Shapes(2).Delete 

'Wait for a few seconds to catch up 
    Application.Wait (Now + TimeValue("0:00:3")) 

'Copy Excel Range 
    rng.Copy 
    'ActiveSheet.ListObjects(1).Range.Copy 

'Paste to PowerPoint and position 
    mySlide.Shapes.PasteSpecial DataType:=ppPasteSourceFormatting, DisplayAsIcon:=msoFalse 
    'PowerPointApp.CommandBars.ExecuteMso ("PasteSourceFormatting") 
    Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count) 

    'Set position: 
     myShapeRange.Left = 20 
     myShapeRange.Top = 100 
     myShapeRange.Height = 400 
     myShapeRange.Width = 675 

'Clear The Clipboard 
    Application.CutCopyMode = False 

End Sub 

Answer 1

我張貼這一點，因爲大多數的你可能會笑：

它有助於保存工作簿作爲宏啓用一個第一 前用VB做有趣的東西。

是的，我沒有facepalm。