Messagebox Stays In Background After PowerPoint Quit

[Lewzerrrr]

In this following bit of code, when I run a powerpoint.quit and try to run a messagebox after, the powerpoint doesn't quit and stays on front with the messagebox and Excel behind?

I'm assuming it doesn't actually quit until the sub ends, how can I resolve this so powerpoint fully quits and switches back to Excel and the messagebox?

CODE NEEDED**

    With ps        .Saved = True
        .Close
    End With
    ppt.Quit
    Set ppt = Nothing
    
        With Application
            .ScreenUpdating = True
            .DisplayAlerts = True
            .EnableEvents = True
        End With
        
    Call ClearImages
    
    ans = MsgBox("Do you want to re-run the Visual Stock Pack?", vbYesNo + vbQuestion)
    
    Select Case ans
        Case vbYes
            Call Box
        Case vbNo
    End Select


End Sub

FULL CODE**

Sub SaveImages()

    'the location to save all the images ------ this may differ to each user, please change to your drive e.g "S:\TS Shared\Distribution\Backup Product Images\"
    Const destFolder$ = "V:\Distribution\Backup Product Images\"


    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Pictures Not Found DIR")


    Dim ppt As Object, ps As Variant, slide As Variant


    Set ppt = CreateObject("PowerPoint.application")
    Set ps = ppt.presentations.Add
    Set slide = ps.slides.Add(1, 1)
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With


    Dim shp As Shape, shpName$
    For Each shp In ws.Shapes
    
        shpName = destFolder & shp.TopLeftCell.Offset(0, -1) & ".png"
        
        If shp.TopLeftCell.Column <> 2 Then
        
        Else
        
            If FileExists(shpName) = True Then
            
                
            Else
            
            shp.Copy
            
                With slide
                    .Shapes.Paste
                    .Shapes(.Shapes.Count).Export shpName, 2
                    .Shapes(.Shapes.Count).Delete
                End With
            
            
            End If
        End If
    Next shp


    With ps
        .Saved = True
        .Close
    End With
    ppt.Quit
    Set ppt = Nothing
    
        With Application
            .ScreenUpdating = True
            .DisplayAlerts = True
            .EnableEvents = True
        End With
        
    Call ClearImages
    
    ans = MsgBox("Do you want to re-run the Visual Stock Pack?", vbYesNo + vbQuestion)
    
    Select Case ans
        Case vbYes
            Call Box
        Case vbNo
    End Select


End Sub