如何粘贴表格并将格式从Excel保留到Powerpoint？ [英] How can I paste a table and keep formatting from Excel to Powerpoint?

问题描述

我正在尝试将表格从Excel粘贴到Powerpoint，并保留源格式（如表）。

I am trying to paste a table from Excel to Powerpoint and keep the source formatting (as a table).

目前使用此方法粘贴：

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

这是以前工作的，但当时我没有选择动态范围并从中创建表，表已经存在，并且此代码正常工作。

This was working before, but at that time I wasn't selecting a dynamic range and creating a table from it, the table already existed and this code worked fine.

我今天尝试过许多不同的事情，但是我对VB的了解不足以解决问题。希望有人可以成为我的救星！

I've tried many different things today, but my knowledge of VB isn't good enough to figure the issue out. Hopefully someone can be my saviour!

整个代码如下：

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

推荐答案

我发布了这个，因为大多数人可能会笑：

I'm posting this because most of you will probably laugh:

它有助于将工作簿保存为一个宏，首先在
之前使用VB进行有趣的事情。

It helps to save the workbook as a macro enabled one first before doing fun stuff with VB.

是的，我做了脸。

这篇关于如何粘贴表格并将格式从Excel保留到Powerpoint？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！