Exporting Excel Charts to PowerPoint

[unknownymous]

Hello Gurus,

Good day!

Could you possibly help me amend the codes I found below:

Basically, I am trying to create a PPT Template for my report - the charts, table format and tab names in excel are same. Is there any way to copy the format in excel (as seen in the excel print preview) on the PPT. All hidden sheets of course will be excluded. The objects are pasted as Paste Link - Microsoft Excel Chart Object. Also, as I'll be keeping the PPT as my template, do i need to create a separate macro for the PPT so I can update the links as the filename of the excel might change based on subject (there's like I can open the file directory and select it).

I did run below codes and it seems like it copied one chart in one slide so I had so many slides. In addition to that, whenever I adjust the height and width of the charts, the font size doesn't change.

= = = =
Option Explicit

Public Sub ChartsToPpt()
Dim sht As Object
Dim cht As Excel.ChartObject
Dim appPpt As Object 'PowerPoint.Application
Dim prs As Object 'PowerPoint.Presentation
Dim chtTitle As String

Set appPpt = CreateObject("PowerPoint.Application")
appPpt.Visible = msoTrue
Set prs = appPpt.Presentations.Open("C:\Users\unkown\Documents\Powerpoint.ppt")

For Each sht In ActiveWorkbook.Sheets
If sht.Visible = xlSheetVisible Then
sht.Select
Select Case LCase(TypeName(sht))
Case "worksheet"
For Each cht In sht.ChartObjects
If cht.Chart.HasTitle = True Then chtTitle = cht.Chart.ChartTitle.Text
cht.Select
Application.CommandBars.ExecuteMso "Copy"
PasteChart appPpt, prs, chtTitle
Next
Case "chart"
If sht.HasTitle = True Then chtTitle = sht.ChartTitle.Text
Application.CommandBars.ExecuteMso "Copy"
PasteChart appPpt, prs, chtTitle
End Select
End If
Next
End Sub

Private Sub PasteChart(ByVal PowerPointApplication As Object, _
ByVal TargetPresentation As Object, _
ByVal ChartTitle As String)
Dim sld As Object 'PowerPoint.Slide
Dim cnt As Long
Const ppLayoutTitleOnly = 11
Const CtrlID1 = "PasteLinkedExcelChartDestinationTheme"
Const CtrlID2 = "PasteExcelChartSourceFormatting"

Set sld = TargetPresentation.Slides.Add( _
TargetPresentation.Slides.Count + 1, ppLayoutTitleOnly)
If sld.Shapes.HasTitle = msoTrue Then sld.Shapes.Title.TextFrame.TextRange.Text = ChartTitle
sld.Select
cnt = sld.Shapes.Count
With PowerPointApplication
If .CommandBars.GetEnabledMso(CtrlID1) = True Then
.CommandBars.ExecuteMso CtrlID1
Else
.CommandBars.ExecuteMso CtrlID2
End If
End With
Do
DoEvents
Loop Until cnt <> sld.Shapes.Count
End Sub

= = = =

Note that I am using Microsoft 2016. Thanks a lot or the help.