I like a challenge though :

Try this with some extra checks

Sub Finish_Size_Transparent_600x400()
Dim opic As Shape
    Dim sngW_Rat As Single
    Dim sngH_Rat As Single
    Dim Path As String
    Dim x As Integer
    Dim origH As Single
    Dim origW As Single
    Dim origT As Single
    Dim origL As Single
    Const pix_W As Long = 600
    Const pix_H As Long = 400
    On Error GoTo Err
    Set opic = ActiveWindow.Selection.ShapeRange(1)
    origH = opic.Height
    origW = opic.Width
    origL = opic.Left
    origT = opic.Top
    If opic.Width <> pix_W Then opic.Width = pix_W
    If opic.Height <> pix_H Then opic.Height = pix_H
    opic.Left = 5
    opic.Top = 5
    DoEvents
    If opic.Line.Visible Then
        sngW_Rat = (ActivePresentation.PageSetup.SlideWidth / (opic.Width + opic.Line.Weight)) * pix_W
        sngH_Rat = (ActivePresentation.PageSetup.SlideHeight / (opic.Height + opic.Line.Weight)) * pix_H
    Else
        sngW_Rat = (ActivePresentation.PageSetup.SlideWidth / (opic.Width)) * pix_W
        sngH_Rat = (ActivePresentation.PageSetup.SlideHeight / (opic.Height)) * pix_H
    End If
    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" And x < 100 'redoes with lower value if larger than spec
        If checkSize(pix_H, 1) = "Too Hot" Then sngH_Rat = sngH_Rat - 0.1 Else sngH_Rat = sngH_Rat + 0.1
        x = x + 1
        Call opic.Export(Path, ppShapeFormatPNG, sngW_Rat, sngH_Rat)
    Wend
    x = 0
    While checkSize(pix_W, 0) <> "Just Right" And 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 - 0.1 Else sngW_Rat = sngW_Rat + 0.1
        Call opic.Export(Path, ppShapeFormatPNG, sngW_Rat, sngH_Rat)
    Wend
    opic.Height = origH
    opic.Width = origW
    opic.Top = origT
    opic.Left = origL
    Exit Sub 'Normal Exit
Err: 'Error exit
    MsgBox "Error " & Err.Description
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