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"

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

1 个答案: