Sub Export_The_Charts_From_Excel_To_PowerPoint()

'Declare the Active\Current Workbook
Dim InputWkb As Workbook
Set InputWkb = ActiveWorkbook

'Select the Charts File
Dim FileName As String
FileName = Application.GetOpenFilename

'Open the Charts Workbook
Workbooks.Open FileName:=FileName
Dim ChartWkb As Workbook
Set ChartWkb = ActiveWorkbook

'Declare PowerPoint Application
Dim PptApp As PowerPoint.Application
Set PptApp = New PowerPoint.Application
PptApp.Visible = msoTrue

'Declare Powerpoint Presentation
Dim PptPres As PowerPoint.Presentation
Set PptPres = PptApp.Presentations.Add

'Declare Powerpoint Slide
Dim PPTSlide As PowerPoint.Slide
SlideNumber = 1
Dim Ch As ChartObject
Dim Sh As Worksheet

'External Loop useful to Loop through all the worksheets in selected workbook
For Each Sh In ChartWkb.Worksheets
Sh.Activate
Set Sh = ChartWkb.Sheets(Sh.Name)

'Internal Loop useful to Loop through all the chart objects in a worksheet
For Each Ch In Sh.ChartObjects
Ch.Chart.ChartArea.Copy
Set PPTSlide = PptPres.Slides.Add(SlideNumber, ppLayoutBlank)
With PPTSlide.Shapes.Paste
'Doesn't Allow to resize the image
.LockAspectRatio = msoFalse
.Left = 150
.Top = 50
.Height = 450
.Width = 720
End With
Next
Next
ChartWkb.Close
SavedTime = Format(Now(), "YYYY_MM_DD_HH_SS")

Application.Wait (Now + TimeValue("00:00:01"))
'Save and close Of PPT Presentation
PptPres.SaveAs InputWkb.Path & "\Output_" & SavedTime & ".pptx"
PptPres.Close

'Nullifying the variables
Set PPTSlide = Nothing
Set PptPres = Nothing
Set PptApp = Nothing
Set InputWkb = Nothing
Set Ch = Nothing
Set Sh = Nothing

MsgBox "Exported The Charts from Excel to PowerPoint"
End Sub