Subscript out of range error when trying to copy Excel charts to Power Point presentation

Question

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 indicate

Answer 1

I think that you are mixing Ranges. Please try the code posted below, which contains quite a few modifications from your original code. I detail below the main ones. You have to set a reference to the Microsoft Excel vvv Object Library. In the VBE, use Tools -> References.

Main changes:

1. Declared the type of arguments in your Function.

2. Changed the Function to Sub (you only perform actions, you do not return a value).

3. Used NamedRange directly. There is no need for the convoluted way in which you used it. The first argument is now superfluous (you may remove it).

4. Used variables to refer to objects. This allows for much easier coding and debugging.

5. Removed some of the Select and Activate. You should not use them unless strictly needed (apparently this is not the case).

There are still quite a few points where you can improve your code, in particular along the lines set above. Please first try it. If it does not work, use the debugger, watches and the immediate window to explore deeper, and give feedback.

Option Explicit

Public dlgOpen As FileDialog
Public folder As String
Public excelApp As Object
Public xlWorkBook As Excel.Workbook
Public xlWorkBook2 As Excel.Workbook
Public PPT As Presentation
Public Name1 As String
Public Name2 As String
Public rng1 As Excel.Range
Public rng2 As Excel.Range
Dim NamedRange As Excel.Range
Dim xlws As Excel.Worksheet
Dim xlsh As Excel.Shape
Dim xlch As Excel.Chart
Dim xlws2 As Excel.Worksheet
Dim xlsh2 As Excel.Shape
Dim xlch2 As Excel.Chart

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")
    Set xlws = xlWorkBook.Sheets("MarketSegmentTotals")
    Set xlsh = xlws.Shapes.AddChart
    Set xlch = xlsh.Chart
    With xlch
        .ChartType = xlColumnClustered
        .SetSourceData Source:=xlws.Range("$A$1:$F$2")
        .Legend.Delete
        .SetElement (msoElementChartTitleAboveChart)
        .SetElement (msoElementDataLabelCenter)
        .ChartTitle.Text = "DD Ready by Market Segment"
    End With
    xlws.ListObjects.Add

    With xlch.Parent
        .Top = 100    ' reposition
        .Left = 100   ' reposition
    End With

    Set xlWorkBook2 = excelApp.workbooks.Open("C:\Users\wzawisa\Downloads\GeneralTotals.xls")
    Set xlws2 = xlWorkBook.Sheets("Totals")
    'xlWorkBook2.Sheets("Totals").Activate
    Set xlsh2 = xlws2.Shapes.AddChart
    Set xlch2 = xlsh2.Chart
    With xlch2
        .ChartType = xlColumnClustered
        .SetSourceData Source:=xlws2.Range("$A$1:$C$2")
        .Legend.Delete
        .SetElement (msoElementChartTitleAboveChart)
        .SetElement (msoElementDataLabelCenter)
        .ChartTitle.Text = "Total DD Ready"
    End With
    xlWorkBook2.ActiveSheet.ListObjects.Add

    With xlws2.Parent
        .Top = 100    ' reposition
        .Left = 100   ' reposition
    End With

    Set rng1 = xlws.Range("B8:F25")
    Set rng2 = xlws2.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 Sub RangeToPresentation(ByVal sheetName As String, NamedRange As Excel.Range)
    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)
    Dim longSlideCount As Integer
    longSlideCount = ppPres.Slides.Count
    ppPres.Slides(1).Select    
    Set PPSlide = ppPres.Slides(ppApp.ActiveWindow.Selection.SlideRange.SlideIndex)

    NamedRange.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 Sub