CODEWITHSUNDEEP
vbapowerpoint
amymon87
amymon87

Reputation: 41

Powerpoint vba - copying table from excel

I have been trying to write a macro that updates a presentation through powerpoint vba using tables from excel.

Here is what I am doing

This exact code was working fine two days ago and is now saying the object is out of range for copying the range "PL". Any help or tips would be great as this is my first time using powerpoint vba.

valnPath = "G:\valnpath\"
PriorPath = "G:\Priorpath\"

Dim xlApp As Object
Dim xlWorkBook As Object
Dim XL As Excel.Application
Dim PPSlide As PowerPoint.Slide

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.DisplayAlerts = False
xlApp.AskToUpdateLinks = False

Set xlWorkBook = xlApp.Workbooks.Open(valnPath & "Presentation Tables 1208.xlsx", True, False)
Set XL = GetObject(, "Excel.Application")
    XL.DisplayAlerts = False
    XL.AskToUpdateLinks = False
    XL.Range("PL").Copy

 ActivePresentation.Slides(3).Select
 Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

Set XL = GetObject(, "Excel.Application")
    XL.DisplayAlerts = False
    XL.AskToUpdateLinks = False
    XL.Range("AvE").Copy

 ActivePresentation.Slides(5).Select
 Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

 Set XL = GetObject(, "Excel.Application")
 XL.Quit

Am I doing anything wrong? Please help me with this,

Thank you

Upvotes: 2

Views: 4880

Answers (2)

nitishhsinghhh
nitishhsinghhh

Reputation: 33

I prefer capturing values in ArrayList or array and then consuming them in PowerPoint slides.

Use this sample code to understand the process.

Function GetDataFromExcel()
    
    ' CreateObject ("Excel.Application")
    Dim xlApp As Excel.Application, xObjFD As FileDialog
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    Set xObjFD = Application.FileDialog(msoFileDialogFilePicker)
    xObjFD.Title = "Select the excel file location " & FileType
    
    With xObjFD
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb", 1
        .Show
        
        ' Selection is not null
        If .SelectedItems.Count > 0 Then
            xFilePath = .SelectedItems.Item(1)
        Else
            Exit Function
        End If
        
        Dim xlWorkBook As Object, valueCollected As String, _
        rowCount As Integer : rowCount = 4
        Set xlWorkBook = xlApp.Workbooks.Open(xFilePath, True, False)
        xlWorkBook.Activate
        Set ArrayValues = New ArrayList
        
loopToCollectData:
        On Error GoTo er
        valueCollected = xlApp.ActiveWorkbook.Sheets(4).Range("B" & rowCount).Value
        If valueCollected <> "" Then
            ArrayValues.Add valueCollected
            rowCount = rowCount + 3
            GoTo loopToCollectData
        End If
    End With
    
    xlWorkBook.Close
    xlApp.Visible = False
    Exit Function

er:
    xlWorkBook.Close
    xlApp.Visible = False
    MsgBox "Please select the relevant input file!"
    End     

End Function

Also, capture the range in an array and then consume it as required. Something like this.

bColumnArray = Application.Transpose(Range(Cells(2, 2), Cells(lastRow, 2)))

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166980

Try this:

valnPath = "G:\valnpath\"
PriorPath = "G:\Priorpath\"

Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim PPSlide As PowerPoint.Slide

Set xlApp = CreateObject("Excel.Application")
With xlApp
   .Visible = True
   .DisplayAlerts = False
   .AskToUpdateLinks = False
End With

Set xlWorkBook = xlApp.Workbooks.Open(valnPath & _
                       "Presentation Tables 1208.xlsx", True, False)

xlApp.Range("PL").Copy
ActivePresentation.Slides(3).Select
Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

xlApp.Range("AvE").Copy
ActivePresentation.Slides(5).Select
Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

xlWorkBook.Close False
xlApp.Quit

Upvotes: 3

Related Questions