グラフをパワーポイントに貼り付け

Question

エクセルのグラフをパワーポイントに「元の書式を保持」したままの貼り付けがしたいです。
しかし実行すると図として貼り付けされてしまいます。
原因と対処方法を教えてほしいです。

Sub PowerPointを立ち上げる()
    Dim ppApp As New PowerPoint.Application
    Dim ppPt As Presentation
    Dim ppSlide As Slide
    Dim ppShape As PowerPoint.Shape
    Dim ws As Worksheet
    Dim test_st As String
    Dim i As Long
    Dim x As Long
    Dim ppPrs As Presentation
    Set ppPrs = ppApp.Presentations.Open(ThisWorkbook.Path & "\グラフ＠.pptx")
    Set ws = ThisWorkbook.Worksheets("A_01")
    
    'グラフの貼り付け
    'CPU
    For i = 1 To 18
    
        ws.ChartObjects("グラフ " & i).Chart.CopyPicture 'グラフを画像としてコピー
        ppPrs.Slides(i).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, Link:=msoFalse 'パワーポイントのコマンドで貼り付け
        If ppApp.ActiveWindow.Selection.Type = ppSelectionNone Or ppApp.ActiveWindow.Selection.Type = ppSelectionSlides Then
            Exit Sub
        End If

            For Each ppShape In ppApp.ActiveWindow.Selection.ShapeRange
            ppShape.LockAspectRatio = msoFalse
                ppShape.Left = Application.CentimetersToPoints(0.8)
                ppShape.Top = Application.CentimetersToPoints(3.7)
                ppShape.Width = Application.CentimetersToPoints(11.875)
                ppShape.Height = Application.CentimetersToPoints(4.6)
            Next ppShape
        
    Next i
 
End Sub

Answer 1

 ws.ChartObjects("グラフ " & i).Chart.CopyPicture 'グラフを画像としてコピー

で、グラフを画像としてコピーしていますから、それを張り付けたものも画像になります。

Comments

[ningen02]

ws.ChartObjects("グラフ " & i).Chart.Copy

に変えても結果は同じになりました。
どうすればいいでしょうか？

Answer 2

調べてみた所、PowerPointのPasteSpecialのDataTypeには「元の書式を保持」がないので、ExecuteMsoでコマンド実行するしかないようです。

参考URLの下部コメント欄を参照
https://ateitexe.com/powerpoint-paste-datatype/

以下、上記URLのコードコピペです。(たかぴーさん作)
※ExecuteMsoは非同期実行なので、グラフ貼り付けが終わるまで待つ処理がポイントです。

'貼り付け前のシート数取得
shc = ppSld.Shapes.Count
 
'貼り付け
ppApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
 
'貼り付け前の枚数が変わるまでwait
Do While shc = ppSld.Shapes.Count
  DoEvents
Loop

Comments

[ningen02]

ありがとうございます。
無事、実装することが出来ました。

Answer 3

画像としてコピーし、さらに

ppPrs.Slides(i).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile,

で張り付け時にも「EnhancedMetafile（拡張メタファイル）」という画像形式で張り付けているので、ここも手を入れる必要があるようにおもいます。ちょっと同じようなものを作って試す暇がないのでとりあえずぱっと見の指摘だけでごめんなさい。

Comments

[ningen02]

ありがとうございます。
どのように修正したら元の書式を保持して貼り付けが出来るかご教授いただきたいです。