I use the following VBA and works perfectly UNTIL I do something that causes it to fail, at which point it kills PowerPoint 2016 and I need to restart.

Sub Finished_600x400()   Dim opic As Shape
   Dim sngW_Rat As Single
   Dim sngH_Rat As Single
   Dim Path As String
   Dim x As Integer
   Const pix_W As Long = 600
   Const pix_H As Long = 400
   Set opic = ActiveWindow.Selection.ShapeRange(1)
   sngW_Rat = (ActivePresentation.PageSetup.SlideWidth / (opic.Width + opic.Line.Weight)) * pix_W
   sngH_Rat = (ActivePresentation.PageSetup.SlideHeight / (opic.Height + opic.Line.Weight)) * pix_H
   If Val(Application.Version) > 14 Then
      sngW_Rat = sngW_Rat * 0.75
      sngH_Rat = sngH_Rat * 0.75
   End If
   Path = "C:\Graphics_ppt\Test_600x400.png"
   Call opic.Export(Path, ppShapeFormatPNG, sngW_Rat, sngH_Rat)
redo:
   While checkSize(pix_H, 1) <> "Just Right" Or x > 100 'redoes with lower value if larger than spec
      If checkSize(pix_H, 1) = "Too Hot" Then sngH_Rat = sngH_Rat - 1 Else sngH_Rat = sngH_Rat + 1
      x = x + 1
      Call opic.Export(Path, ppShapeFormatPNG, sngW_Rat, sngH_Rat)
   Wend
   x = 0
    While checkSize(pix_W, 0) <> "Just Right" Or x > 100 'redoes with lower value if larger than spec
    x = x + 1
      If checkSize(pix_W, 0) = "Too Hot" Then sngW_Rat = sngW_Rat - 1 Else sngW_Rat = sngW_Rat + 1
      Call opic.Export(Path, ppShapeFormatPNG, sngW_Rat, sngH_Rat)
   Wend
End Sub
Function checkSize(lngTarget As Long, dimension As Long) As String
   Dim objShell As Object
   Dim objFolder As Object
   Dim objFile As Object
   Dim strSize As String
   Dim rayw() As String
   Set objShell = CreateObject("Shell.Application")
   Set objFolder = objShell.NameSpace("C:\Graphics_ppt")
   Set objFile = objFolder.ParseName("Test_600x400.png")
   strSize = objFile.ExtendedProperty("Dimensions")
   strSize = Mid(strSize, 2, Len(strSize) - 2)
   rayw = Split(strSize, "x")
   Select Case Val(rayw(dimension))
 Case Is < lngTarget
 checkSize = "Too Cold"
 Case Is > lngTarget
 checkSize = "Too Hot"
 Case Is = lngTarget
 checkSize = "Just Right"
 End Select
End Function
What can be done so if it does fail it does not kill PowerPoint 2016 - I would prefer it to just throw an error message.

Suggestions