I am trying to copy charts from excel to PPT in a PPT macro using a function. Though, when I try to run the function it says "Subscript out of range" on the line indicated below and I am really confused why.
Public dlgOpen As FileDialog
Public folder As String
Public excelApp As Object
Public xlWorkBook As Object
Public xlWorkBook2 As Object
Public PPT As Presentation
Public Name1 As String
Public Name2 As String
Public rng1 As Range
Public rng2 As Range
Dim NamedRange As Range
Public Sub GenerateVisual()
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
With xlWorkBook.ActiveChart.Parent
.Top = 100 ' reposition
.Left = 100 ' reposition
End With
Set xlWorkBook2 = excelApp.workbooks.Open("C:\Users\wzawisa\Downloads\GeneralTotals.xls")
xlWorkBook2.Sheets("Totals").Activate
xlWorkBook2.ActiveSheet.Shapes.AddChart.Select
xlWorkBook2.ActiveChart.ChartType = xlColumnClustered
xlWorkBook2.ActiveChart.SetSourceData Source:=xlWorkBook2.ActiveSheet.Range("Totals!$A$1:$C$2")
xlWorkBook2.ActiveChart.Legend.Delete
xlWorkBook2.ActiveChart.SetElement (msoElementChartTitleAboveChart)
xlWorkBook2.ActiveChart.SetElement (msoElementDataLabelCenter)
xlWorkBook2.ActiveChart.ChartTitle.Text = "Total DD Ready"
xlWorkBook2.ActiveSheet.ListObjects.Add
With xlWorkBook2.ActiveChart.Parent
.Top = 100 ' reposition
.Left = 100 ' reposition
End With
Set rng1 = xlWorkBook.Sheets("MarketSegmentTotals").Range("B8:F25")
Set rng2 = xlWorkBook2.Sheets("Totals").Range("A8:C25")
Call RangeToPresentation("MarketSegmentTotals", rng1)
Call RangeToPresentation("Totals", rng2)
'Set dlgOpen = Application.FileDialog(Type:=msoFileDialogFolderPicker)
'
'dlgOpen.Show
'dlgOpen.Title = "Select Report Location"
'
'folder = dlgOpen.SelectedItems(1)
End Sub
Public Function RangeToPresentation(sheetName, NamedRange)
Dim ppApp As Object
Dim ppPres As Object
Dim PPSlide As Object
Set ppApp = GetObject(, "Powerpoint.Application")
Set ppPres = ppApp.ActivePresentation
ppApp.ActiveWindow.ViewType = ppViewNormal
' Select the last (blank slide)
longSlideCount = ppPres.Slides.Count
ppPres.Slides(1).Select
Set PPSlide = ppPres.Slides(ppApp.ActiveWindow.Selection.SlideRange.SlideIndex)
xlWorkBook.Sheets(sheetName).Range(NamedRange.Address).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 Function