如何粘贴表格并将格式从Excel转换为Powerpoint？

我想从Excel粘贴表格到Powerpoint并保持源格式（作为表格）。如何粘贴表格并将格式从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

来源

2016-01-20 Simon JL

这不是VB.Net代码。请删除标签 – Plutonix

你有没有试过把它作为图像复制？ –

FYR ... http://stackoverflow.com/questions/25558354/best-way-to-copy-excel-table-into-powerpoint-2010 – Linga

我张贴这一点，因为大多数的你可能会笑：

它有助于保存工作簿作为宏启用一个第一前用VB做有趣的东西。

是的，我没有facepalm。

来源

2016-01-21 13:21:07

如何粘贴表格并将格式从Excel转换为Powerpoint？

回答

相关问题