将表格从 Excel 粘贴到 PowerPoint 的最佳方法（保持源格式）

Question

我目前正在通过 PowerShell 中的自动化在 Excel 中构建一个表格。这个步骤效果很好，桌子完全按照我的喜好结束。我现在想将其粘贴到 PowerPoint 演示文稿中。

PowerPoint 演示文稿是我创建的模板，然后填充了其他元素。除了这个，我想我的每一部分都裂开了。

我想从已在后台打开的 Excel 文件中粘贴。到目前为止，它已被激活，并选择了所需的范围。然后将其粘贴到 PowerPoint 窗口中。但是，它以灰色表格的形式出现，没有任何格式。

以前在将我的模板放在一起并手动测试不同的组件时，下面的行是从 Excel 中粘贴的，非常完美。

ActivePresentation.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"

但是，由于转向自动化（并与不同的窗口等交互），它不再起作用。而是给出“无法创建 activex 组件”错误。

完整代码如下：

Function CreateFLUTemplate(templateFile As String, PresPath As Variant, TalkingPointsDoc As Variant, LineOfBusiness As String, PolicyLink As String)

' Declare variables to be used
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim WordApp As Word.Application
Dim PPFile As Object, WordDoc As Object
Dim TitleBox As PowerPoint.Shape, MetricsHeader As PowerPoint.Shape, MetricsTable As PowerPoint.Shape, PhishingHeader As PowerPoint.Shape, PhishingTable As PowerPoint.Shape
Dim PolicyHeader As PowerPoint.Shape, PolicyBox As PowerPoint.Shape, TalkingPointsHeader As PowerPoint.Shape, TalkingPointsBox As PowerPoint.Shape, shp As PowerPoint.Shape
Dim PPSlide As Slide
Dim WAIT As Double
Dim ShapeArray As Variant, LabelsArray As Variant, DateLabel As Variant
Dim i As Integer

' Open blank presentation file to be updated
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = msoTrue
Set PPFile = PPApp.Presentations.Open(PresPath)
Set PPPres = PPApp.ActivePresentation

' Construct date that will be used in the header sections
DateLabel = Format(DateSerial(Year(Date), Month(Date), 0), "d mmmm yyyy")

' Set slide object so we can set our shape variables etc
Set PPSlide = PPPres.Slides(1)

' Copy finished Excel table

' Activate Spreadsheet with table to be copied
Windows(templateFile).Activate
Range("A1:E10").Copy

PPApp.Windows(1).Activate
' Paste Excel table in to PowerPoint
'ActivePresentation.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
'PPPres.Slides(1).Shapes.PasteSpecial(DataType:=ppPasteShape).Select
PPApp.ActivePresentation.Slides(1).Shapes.Paste

' Introduce delay to let paste action happen before moving on
WAIT = Timer
While Timer < WAIT + 0.5
   DoEvents
Wend

' Take pasted table and save to object
If PPApp.ActiveWindow.Selection.Type = ppSelectionNone Then
    MsgBox "Nothing is selected", vbExclamation
Else
    For Each shp In PPApp.ActiveWindow.Selection.ShapeRange
        Set MetricsTable = PPApp.ActivePresentation.Slides(1).Shapes(shp.Name)
    Next shp
End If

' Reposition and resize pasted table.
With MetricsTable
    .Left = 27
    .Top = 108
    .Width = 363
    .Table.Columns(1).Width = 148
    .Table.Columns(2).Width = 28
    .Table.Columns(3).Width = 28
    .Table.Columns(4).Width = 28
    .Table.Columns(5).Width = 131
    .Height = 227
End With

Answer 1

设法修复它，不敢相信我没想过要检查代码以查找已经在工作的非常相似的操作！我应该一直在使用：

PPPres.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"