現在、PowerShellのオートメーションを使用してExcelでテーブルを作成しています。このステップはうまくいく、テーブルは私が好きなだけ正確に終わる。これをPowerPointプレゼンテーションに貼り付けることにしました。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