jlingle
04-28-2016, 11:07 AM
I have some code that has worked well. It's PowerPoint VBA that calls up Excel worksheets and inserts values from the spreadsheet into slides. However, recently the code started to give me a peculiar error now that I am running Office 2016 with Office 365. The error message is "Run-time error'-2147417848 (80010108)': Automation error: The object invoked has disconnected from its clients."
What seems to be happening is the PP opens the worksheet and reads in values without a problem. It then moves on to another section of code and tries to read in some more values. However, by then the workbook has for some reason disconnected. In the code listed below, the bolded code executes fine, loading values into the slide. A few lines later, however, when the program tries to execute the bolded italicized code, the link to the worksheet has been broken and I get the error mentioned above. I can reset the link to the spreadsheet in the immediate window with the command "Set XLBookL = GetObject(NameOfFile)" and the lines causing the error will execute. Anyone have any ideas why that link to the spreadsheet is suddenly disconnecting between the two bolded sets of code on some occasion, but not others??
Thanks for any suggestions.
Sub TopTen()
Dim XLBookL As Object 'Holds any spreadsheet opened to complete this spreadsheet
Dim NameOfFile As String 'String with the name of the workbook
Dim NameOfTab As String 'String with the name of the tab
Dim fQRow As String ' Row with the first question
Dim QCol As String ' Column with the question in it
Dim nSkipRow As Single ' Rows to skip until row with the next question or Fav scores
Dim FavCol As String ' Col with Fav score
Dim i, j As Single ' Loop counters
' Set variables to locate data. The name of the templates are written in text boxes at the bottom of the slide.
NameOfFile = cPath & "reports\excelParts\rankItemFav" & lReports(CurrentRPT, 3) & ".xlsx" 'File name with data for template slide
NameOfTab = lReports(CurrentRPT, 2) ' Tab where data for this template is stored
Set XLBookL = GetObject(NameOfFile) ' opens file with data for ResponseRate template
fQRow = "5" ' First row with data in the table
QCol = "B" ' Column with question data
nSkipRow = 2 ' How much to increment the loop count to get to next row of data
FavCol = "F" ' Row with fav data in it
' Load Template with data from the spreadsheet file
i = 0 ' Slide table row into which data will be inserted
j = Val(fQRow) ' Represents the current row in the spreadsheet from which data is drawn
For i = 1 To 10
With Application.Presentations(CurrentTMPF).Slides(CurrentTMPS).Shapes("Top-Ten-Table").Table
.Cell(i, 1).Shape.TextFrame.TextRange.Text = _
XLBookL.Sheets(NameOfTab).Range(QCol & CStr(j)) 'Load question into table
.Cell(i, 2).Shape.TextFrame.TextRange.Text = _
Format(XLBookL.Sheets(NameOfTab).Range(FavCol & CStr(j)), "##%") 'Load the favorable scores
End With
j = j + nSkipRow
Next i
' Clean up the and close the worksheet and chartdata
XLBookL.Close saveChanges:=False
End Sub
What seems to be happening is the PP opens the worksheet and reads in values without a problem. It then moves on to another section of code and tries to read in some more values. However, by then the workbook has for some reason disconnected. In the code listed below, the bolded code executes fine, loading values into the slide. A few lines later, however, when the program tries to execute the bolded italicized code, the link to the worksheet has been broken and I get the error mentioned above. I can reset the link to the spreadsheet in the immediate window with the command "Set XLBookL = GetObject(NameOfFile)" and the lines causing the error will execute. Anyone have any ideas why that link to the spreadsheet is suddenly disconnecting between the two bolded sets of code on some occasion, but not others??
Thanks for any suggestions.
Sub TopTen()
Dim XLBookL As Object 'Holds any spreadsheet opened to complete this spreadsheet
Dim NameOfFile As String 'String with the name of the workbook
Dim NameOfTab As String 'String with the name of the tab
Dim fQRow As String ' Row with the first question
Dim QCol As String ' Column with the question in it
Dim nSkipRow As Single ' Rows to skip until row with the next question or Fav scores
Dim FavCol As String ' Col with Fav score
Dim i, j As Single ' Loop counters
' Set variables to locate data. The name of the templates are written in text boxes at the bottom of the slide.
NameOfFile = cPath & "reports\excelParts\rankItemFav" & lReports(CurrentRPT, 3) & ".xlsx" 'File name with data for template slide
NameOfTab = lReports(CurrentRPT, 2) ' Tab where data for this template is stored
Set XLBookL = GetObject(NameOfFile) ' opens file with data for ResponseRate template
fQRow = "5" ' First row with data in the table
QCol = "B" ' Column with question data
nSkipRow = 2 ' How much to increment the loop count to get to next row of data
FavCol = "F" ' Row with fav data in it
' Load Template with data from the spreadsheet file
i = 0 ' Slide table row into which data will be inserted
j = Val(fQRow) ' Represents the current row in the spreadsheet from which data is drawn
For i = 1 To 10
With Application.Presentations(CurrentTMPF).Slides(CurrentTMPS).Shapes("Top-Ten-Table").Table
.Cell(i, 1).Shape.TextFrame.TextRange.Text = _
XLBookL.Sheets(NameOfTab).Range(QCol & CStr(j)) 'Load question into table
.Cell(i, 2).Shape.TextFrame.TextRange.Text = _
Format(XLBookL.Sheets(NameOfTab).Range(FavCol & CStr(j)), "##%") 'Load the favorable scores
End With
j = j + nSkipRow
Next i
' Clean up the and close the worksheet and chartdata
XLBookL.Close saveChanges:=False
End Sub