Copying table in Powerpoint VBA from Excel Spreadhseet

  • Hi, I am trying to use a Combobox in Powerpoint. I needed to filter the table (in excel) according to selection being made in Powerpoint and then populate the slide with that filtered data.

    I have been facing a problem with linking the table in excel with the powerpoint VBA. I did give a name to my table ranges in excel and and have been trying to reference that in ppt VBA using the same name.

    My code looks like this:

    Private Sub ComboBox1_Change()

    Dim wb As Object
    Dim tbl As Object
    Dim ExcelApp As Object
    Dim sld As Slide
    Dim ComboBx As Shape, NewShape As Shape, OldShape As Shape
    Dim myCriteria As String, ExcelFilePath As String
    Dim ComboBoxName As String, DataImageName As String
    Dim ExcelTableName As String, TableSheet As String
    Dim SlideNumber As Long

    'Input Values
    ExcelFilePath = "C:\Users\VAgarwa7\Desktop\work\0223\NSN_Markets_ver_2"
    SlideNumber = 1
    ComboBoxName = "ComboBox1"
    DataImageName = "SalesData"
    ExcelTableName = "Table2"
    TableSheet = "WorkAround"

    'Store Object Variables
    Set sld = ActivePresentation.Slides(SlideNumber)
    Set ComboBx = sld.Shapes(ComboBoxName)

    'Create an Instance of Excel
    On Error Resume Next

    'Is Excel already opened?
    Set ExcelApp = GetObject(class:="Excel.Application")
    ExcelApp.Visible = False

    'Clear the error between errors

    'If Excel is not already open then open PowerPoint
    If ExcelApp Is Nothing Then Set ExcelApp = CreateObject(class:="Excel.Application")

    'Handle if the Excel Application is not found
    If Err.Number = 429 Then
    MsgBox "Excel could not be found, aborting."
    Exit Sub
    End If

    On Error GoTo 0

    'Open Excel File
    Set wb = ExcelApp.Workbooks.Open(ExcelFilePath)

    'Determine User Selection
    myCriteria = ComboBx.OLEFormat.Object.Value

    'Filter on select item

    Set tbl = wb.Worksheets(TableSheet).ListObjects(ExcelTableName)

    tbl.Range.AutoFilter Field:=2, Criteria1:=myCriteria

    'Copy/Paste Data

    'Store characteristics about current Data Image & remove
    Set OldShape = sld.Shapes(DataImageName)
    x = OldShape.Left
    y = OldShape.Top
    Z = OldShape.Width

    'Paste to PowerPoint and position
    sld.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile

    'Set Variable Equal To Newly Pasted Image
    'Handle Excel 2010 & prior bug where combobox stays "in front" of all images no matter what
    If sld.Shapes(sld.Shapes.Count).Type = msoOLEControlObject Then
    Set NewShape = sld.Shapes(sld.Shapes.Count - 1)
    Set NewShape = sld.Shapes(sld.Shapes.Count)
    End If

    'Reposition and Resize Filtered Picture
    NewShape.Left = x
    NewShape.Top = y
    NewShape.Width = Z
    NewShape.Name = DataImageName

    'Close Excel File
    ExcelApp.CutCopyMode = False
    wb.Close SaveChanges:=False

    End Sub


    The error is thrown at the BOLD location. The error message is "Subscripts out of range". I tried almost everything. The names of the worksheet and tablename are perfectly fine.

    Please help me with this.

    Thanks in advance

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!