Microsoft Office Forums - View Single Post - VBA failing when updaing TextBox in PowerPoint

IIOII · 07-28-2016, 09:41 PM

Greetings. The intent of the below code is to access a range within an Excel spreadsheet, find a value and then update an ActiveX TextBox within a PowerPoint slide with the value and then change the colour. The codes works well when there are no other shapes or tables on the slide. However when there are, it's throwing the run time error -2147188160 (80048240): OLEFormat (unknown member): Invalid Request. This property only applies to OLE objects.

Any suggestions on how to best skip all non-required shapes or tables except the required TextBox's? Sample files attached below.

Code:

Private Sub CommandButton1_Click()

Dim objExcel As Object
Dim exWb As Object
Dim rng As Object
Dim c As Object
Dim TaskStatus As String
Dim oTB As PowerPoint.Shape

    Set objExcel = CreateObject("Excel.Application")
    Set exWb = objExcel.Workbooks.Open("C:\Temp\SAMPLE.xlsm")
    Set rng = exWb.Sheets("Data").Range("TEEE")

    For Each c In rng.Cells
        TaskStatus = c.Offset(0, 1)
        MsgBox TaskStatus
        
        For Each oTB In ActivePresentation.Slides(1).Shapes
            If oTB.OLEFormat.Object.Name = c Then
                oTB.OLEFormat.Object.Text = TaskStatus
                If TaskStatus = "B" Then oTB.OLEFormat.Object.BackColor = RGB(0, 0, 255)
                If TaskStatus = "R" Then oTB.OLEFormat.Object.BackColor = RGB(255, 0, 0)
                If TaskStatus = "A" Then oTB.OLEFormat.Object.BackColor = RGB(255, 204, 0)
                If TaskStatus = "G" Then oTB.OLEFormat.Object.BackColor = RGB(0, 255, 0)
                Exit For
            End If

        Next
    Next

    exWb.Close
    objExcel.Quit

    Set exWb = Nothing
    Set objExcel = Nothing
    Set rng = Nothing
    Set c = Nothing
    Set oTB = Nothing

End Sub

PP_SAMPLE.pptm
SAMPLE.xlsm