VBA to Keep Source Formatting and Link Data when pasting a chart from Excel to PPT

[notlad1974]

I am quite new to Visual Basic. I have created the below code to pull 3 slides from an Excel workbook into a preformatted Powerpoint deck. I would prefer to have it paste keeping the source (Excel) formatting and Data Link. I cannot figure out how to do so. Any help would be greatly appreciated. Thanks!

Sub ChartToPresentation()
' Uses Early Binding to the PowerPoint Object Model
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.slide

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

'Copy "Chart 1" on "Sheet1" to Slide # 2
' Copy "Chart 1" on "Sheet1" as a picture
ActiveWorkbook.Sheets("Global Bookings Summary").ChartObjects("Chart 1").Chart.ChartArea.Copy
' Paste chart to Slide # 4
With PPPres.Slides(1).Shapes.PasteSpecial
' Align pasted chart
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
End With

'Copy "Chart 1" to from "Sheet3" to Slide # 4
' Copy "Chart 1" on "Sheet3" as a picture
ActiveWorkbook.Sheets("Global IQRR by Seg").ChartObjects("Chart 1").Chart.ChartArea.Copy
' Paste chart to Slide # 4
With PPPres.Slides(2).Shapes.PasteSpecial
With ActiveChart.Parent
.Height = 638 ' resize
.Width = 1000 ' resize
.Top = 1 ' reposition
.Left = 1 ' reposition
End With

'Copy "Chart 1" to from "Sheet3" to Slide # 4
' Copy "Chart 1" on "Sheet3" as a picture
ActiveWorkbook.Sheets("Global Loss Analysis Chart").ChartObjects("Chart 1").Chart.ChartArea.Copy
' Paste chart to Slide # 4
With PPPres.Slides(3).Shapes.PasteSpecial
' Align pasted chart
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
End With

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End With
End Sub

 

[notlad1974]

To follow up. After doing more research I understand that I need to add the below code. However I am unsure where to add it. Please help.

PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")

 

[WhiskeyTangoFiretruck]

For anyone still wondering about Keeping Source Formatting while pasting from excel to power point. I got this to work.
Sub SigAcc()
Application.ScreenUpdating = False
Dim myPresentation As Object
Set myPresentation = CreateObject("PowerPoint.Application")
Dim PowerPointApp As Object
Dim PPTApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim newadaptivepath As String
Dim ohadaptivepath As String
ohadaptivepath = left(ThisWorkbook.path, Len(ThisWorkbook.path) - 3)
newadaptivepath = ohadaptivepath & "New"
Set objPPApp = New PowerPoint.Application


Set PPSlide = myPresentation.ActivePresentation.Slides(2)


lastrow = ThisWorkbook.Worksheets("Sig Accomplishments").Range("A" & Rows.Count).End(xlUp).Row
For p = PPSlide.Shapes.Count To 1 Step -1
Set myShape = PPSlide.Shapes(p)
If myShape.Type = msoPicture Then myShape.Delete
Next






Set myPresentation = myPresentation.ActivePresentation
Set mySlide = myPresentation.Slides(2)
On Error Resume Next




'assigning range into variable
Set r = ThisWorkbook.Worksheets("Sig Accomplishments").Range("A1:C" & lastrow)
On Error Resume Next


'If we have already opened powerpoint
Set PowerPointApp = GetObject(Class:="PowerPoint.Application")


'If Powerpoint is not opened
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="Powerpoint.Application")


With ThisWorkbook.Worksheets("Sig Accomplishments").Range("C3:C" & lastrow)
.WrapText = True
End With


r.Copy


'to paste range
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
mySlide.Shapes.PasteSpecial
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.left = ActivePresentation.PageSetup.SlideWidth / 2 - ActivePresentation.PageSetup.SlideWidth / 2
myShape.Top = 80
PowerPointApp.Visible = True
PowerPointApp.Activate



'to clear the cutcopymode from clipboard
Application.CutCopyMode = False
End Sub