Home>

I want to paste an Excel graph with "Keep original formatting" in PowerPoint.
However, if you execute it, it will be pasted as a figure.
I would like to know the cause and how to deal with it.

Launch 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&"\ graph @ .pptx")
    Set ws = ThisWorkbook.Worksheets ("A_01")
    'Paste graph
    'CPU
    For i = 1 To 18
        ws.ChartObjects ("Chart"&i) .Chart.CopyPicture 'Copy chart as picture
        ppPrs.Slides (i) .Shapes.PasteSpecial DataType: = ppPasteEnhancedMetafile, Link: = msoFalse 'Paste with PowerPoint command
        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 ("Chart"&i) .Chart.CopyPicture 'Copy chart as picture


    And since the graph is copied as an image, the pasted image is also an image.

  • Answer # 2

    When I looked into it, PowerPoint PasteSpecial's DataType doesn't have "Keep original format", so it seems that there is no choice but to execute the command with ExecuteMso.

    See the comment section below the reference URL
    https://ateitexe.com/powerpoint-paste-datatype/

    Here is the code copy of the above URL. (By Takapi-san)
    * Since ExecuteMso is asynchronous execution, the point is to wait until the graph pasting is completed.

    'Get the number of sheets before pasting
    shc = ppSld.Shapes.Count
    'pasting
    ppApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
    'Wait until the number before pasting changes
    Do While shc = ppSld.Shapes.Count
      DoEvents
    Loop

  • Answer # 3

    Copy as an image and

    ppPrs.Slides (i) .Shapes.PasteSpecial DataType: = ppPasteEnhancedMetafile,
    Even when pasting with

    , it is pasted in an image format called "EnhancedMetafile", so it seems that it is necessary to get this too. I don't have the time to make a similar one and try it out.