Run Time Error '91':

Object Variable or With block variable not set

Written this below code but not able to execute because of Object Variable Error

Sub Create_PPT()

Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim mySlideArray As Variant
Dim myRangeArray As Variant
Dim x As Long
Dim wb As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim sh4 As Worksheet
Dim sh5 As Worksheet
Dim sh6 As Worksheet

        Set wb = ActiveWorkbook
        Set sh1 = ThisWorkbook.Sheets("Close")
        Set sh2 = ThisWorkbook.Sheets("Trend")
        Set sh3 = ThisWorkbook.Sheets("Total_Cloud_Chart")
        Set sh4 = ThisWorkbook.Sheets("AWS_Summary_Chart")
        Set sh5 = ThisWorkbook.Sheets("Compute_Chart")
        Set sh6 = ThisWorkbook.Sheets("Storage_Chart")
    
    
    On Error Resume Next
    
        Set PowerPointApp = GetObject(class:="PowerPoint.Application")
        Err.Clear
        
        If PowerPointApp Is Nothing Then
            MsgBox "PowerPoint Presentation is not opened, aborting."
            Exit Sub
        End If
        
        If Err.Number = 429 Then
            MsgBox "PowerPoint could not be found, aborting."
            Exit Sub
        End If
        
    On Error GoTo 0
    
    PowerPointApp.ActiveWindow.Panes(2).Activate
    
    Set myPresentation = PowerPointApp.ActivePresentation
    
    mySlideArray = Array(3, 4, 5, 6, 7, 8)
    
    myRangeArray = Array(sh1.Range("A1:F14"), sh2.Range("A1:Q28"), sh3.Range("A1:P36"), sh4.Range("A1:AA26"), sh5.Range("A1:AA40"), sh6.Range("C1:AC28"))

For x = LBound(mySlideArray) To UBound(mySlideArray)

    myRangeArray(x).Copy
        
    On Error Resume Next
    
        Set shp = PowerPoint.ActiveWindow.Selection.ShapeRange
    
    On Error GoTo 0
    
    With myPresentation.PageSetup
    
        shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2)
        shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)
    
    End With

Next x

Application.CutCopyMode = False

PowerPoint.Save

MsgBox "Report Completed"

End Sub

CodePudding user response：

Its good practise to encapsulate 'One Error Resume Next' in a Try... function.

A try function does only one thing and reports true or false for success or fail. The actual value from the operation in the try function is passed back via a ByRef parameter.

So, instead of this

On Error Resume Next
    
        Set PowerPointApp = GetObject(class:="PowerPoint.Application")
        Err.Clear
        
        If PowerPointApp Is Nothing Then
            MsgBox "PowerPoint Presentation is not opened, aborting."
            Exit Sub
        End If
        
        If Err.Number = 429 Then
            MsgBox "PowerPoint could not be found, aborting."
            Exit Sub
        End If
        
    On Error GoTo 0

You would write

Public Function TryGetPowerpointApp(byRef ipPowerPointApp as object) as boolean
    On error Resume Next
    set ipPowerpointApp = GetObject(class:="PowerPoint.Application")
    TryGetPowerPointApp = err.number = 0
    err.clear
end function

SO in your code you can now say

If Not TryGetPowerpointApp(PowerpointApp) then
    'do error stuff
end if
' continue on the happy path with PowerPointApp

There are several places in your code where the same strategy can be deployed.

You should look at the use of On Error Resume Next that is not encapsulated as above as BAD code.

CodePudding user response：

This is a serious recomendation. Youd need to learn to debug code in VBA because a missing object reference will come up again sooner or later. Heres something to start with:

1. Direct Window
2. Step trough code
3. Brakepoints
4. Locals Window