Copy Excel charts and tables to Powerpoint - vba

Question

I am trying to create charts and tables in excel and then copy them to slides in powerpoint all through a PowerPoint VBA macro. I have the charts and tables created but I am having an issue with copying and pasting them over. I am not familiar with the syntax to do so. Any help would be greatly appreciated as I am new to PowerPoint VBA.
Sub GenerateVisual()
Dim dlgOpen As FileDialog
Dim folder As String
Dim excelApp As Object
Dim xlWorkBook As Object
Dim xlWorkBook2 As Object
Dim PPT As Presentation
Dim Name1 As String
Dim Name2 As String
Set PPT = ActivePresentation
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = True
Set xlWorkBook = excelApp.workbooks.Open("C:\Users\wzawisa\Downloads\MarketSegmentTotals.xls")
xlWorkBook.Sheets("MarketSegmentTotals").Activate
xlWorkBook.ActiveSheet.Shapes.AddChart.Select
xlWorkBook.ActiveChart.ChartType = xlColumnClustered
xlWorkBook.ActiveChart.SetSourceData Source:=xlWorkBook.ActiveSheet.Range("MarketSegmentTotals!$A$1:$F$2")
xlWorkBook.ActiveChart.Legend.Delete
xlWorkBook.ActiveChart.SetElement (msoElementChartTitleAboveChart)
xlWorkBook.ActiveChart.SetElement (msoElementDataLabelCenter)
xlWorkBook.ActiveChart.ChartTitle.Text = "DD Ready by Market Segment"
xlWorkBook.ActiveSheet.ListObjects.Add
xlWorkBook.ActiveSheet.ChartObjects(1).Select 'My attempt to copy them over but it doesnt work
PPT.ActiveWindow.View.Paste
End Sub

Answer 1

This sub will get you on your way. It needs some tweaks but this can copy over a range into a PPT:
Public Sub RangeToPresentation(sheetName, NamedRange)
Dim CopyRng As Range
Set CopyRng = Sheets(sheetName).Range(NamedRange)
Dim ppApp As Object
Dim ppPres As Object
Dim PPSlide As Object
If Not TypeName(CopyRng) = "Range" Then
MsgBox "Please select a worksheet range and try again.", vbExclamation, _
"No Range Selected"
Else
Set ppApp = GetObject(, "Powerpoint.Application")
Set ppPres = ppApp.ActivePresentation
ppApp.ActiveWindow.ViewType = ppViewNormal
Dim longSlideCount As Long
' Determine how many slides are in the presentation.
longSlideCount = ppPres.Slides.Count
With ppPres
' Insert a slide at the end of the presentation
Set PPSlide = ppPres.Slides.Add(longSlideCount + 1, ppLayoutBlank)
End With
' Select the last (blank slide)
longSlideCount = ppPres.Slides.Count
ppPres.Slides(longSlideCount).Select
Set PPSlide = ppPres.Slides(ppApp.ActiveWindow.Selection.SlideRange.SlideIndex)
CopyRng.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
' Paste the range
PPSlide.Shapes.Paste.Select
'Set the image to lock the aspect ratio
ppApp.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoTrue
'Set the image size slightly smaller than width of the PowerPoint Slide
ppApp.ActiveWindow.Selection.ShapeRange.Width = ppApp.ActivePresentation.PageSetup.SlideWidth - 10
ppApp.ActiveWindow.Selection.ShapeRange.Height = ppApp.ActivePresentation.PageSetup.SlideHeight - 10
'Shrink image if outside of slide borders
If ppApp.ActiveWindow.Selection.ShapeRange.Width > 700 Then
ppApp.ActiveWindow.Selection.ShapeRange.Width = 700
End If
If ppApp.ActiveWindow.Selection.ShapeRange.Height > 600 Then
ppApp.ActiveWindow.Selection.ShapeRange.Height = 600
End If
' Align the pasted range
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
' Clean up
Set PPSlide = Nothing
Set ppPres = Nothing
Set ppApp = Nothing
End If
End Sub