Quitter Excel à l'aide de VBA provoque une erreur d'exécution 424

Question

J'ai écrit une macro VBA qui ouvre un document HTML dans Excel (afin d'effectuer divers calculs). Excel recherchera le document HTML dans le dossier actuel. S'il ne le trouve pas, il produira une boîte de dialogue d'ouverture de fichier dans laquelle l'utilisateur peut accéder manuellement à l'emplacement du document HTML. Tout va bien jusqu'à présent. Cependant, si l'utilisateur choisit Annuler (plutôt que de sélectionner un fichier), je souhaite qu'Excel affiche un message et quitte.

Le message est généré mais le code s'arrête avec l'erreur suivante:

Erreur d'exécution '424': objet requis.

Cela ne semble pas trop compliqué, mais je me suis heurté à un mur de briques après les autres pour essayer de comprendre la cause du problème.

Le sous-serveur qui semble ne pas fonctionner est:

Sub ExitWithoutPrompt()

MsgBox "You failed to select a file, therefore Excel will now close.  Please refer to the readme file."
Excel.Application.DisplayAlerts = False
Excel.Application.Quit

End Sub

J'utilise MS Excel 2002, mais je souhaite vivement que la solution fonctionne sur autant de variantes d'Excel que possible.

Toute aide reçue avec gratitude quant à mes erreurs. Soit dit en passant, je suis un débutant. Donc, dans la mesure du possible, soyez long avec les conseils que vous pourriez avoir pour moi ...

Comme il pourrait être utile d'inclure ci-dessous (au risque de rendre ce post difficile à manier), les deux autres sous-marins que j'utilise dans la macro:

Premier sous:

Sub Endurance()

Call OpenHTML

Range("G27").Value = "Category"
Range("G28").Value = "Meat"
Range("G29").Value = "Veg"
Range("G30").Value = "PRP"
Range("F27").Value = "Fleet"
Range("E27").Value = "Consumption"

Range("E32").Value = "Endurance"

Range("E33").Value = "Lowest Category"
Range("E34").Value = "Fleet"
Range("E35").Value = "Consumption"

Range("E27, F27, G27, E32").Font.Bold = True
Range("F28").Value = WorksheetFunction.Sum(Range("E8,E9,E11,E14,E21"))
Range("E28").Value = WorksheetFunction.Sum(Range("G8,G9,G11,G14,G21"))
Range("F29").Value = WorksheetFunction.Sum(Range("E10,E16"))
Range("E29").Value = WorksheetFunction.Sum(Range("G10,G16"))
Range("F30").Value = WorksheetFunction.Sum(Range("E20,E22"))
Range("E30").Value = WorksheetFunction.Sum(Range("G20,G22"))

Columns("E:F").EntireColumn.AutoFit

Range("G28:G30, E27, F27, G27, G33").Select
    With Selection
        .HorizontalAlignment = xlRight
    End With

Range("E27:G30, E32:G35").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone


Dim Endurance As Double
Endurance = WorksheetFunction.Min(Range("F28:F30"))
Range("G34").Value = WorksheetFunction.RoundDown(Endurance, 0)

Endurance = WorksheetFunction.Min(Range("E28:E30"))
Range("G35").Value = WorksheetFunction.RoundDown(Endurance, 0)

Range("G33").Value = Endurance

Dim LowCat As String

LowCat = WorksheetFunction.VLookup(Endurance, Range("E28:G30"), 3, False)
Range("G33").Value = LowCat

ActiveSheet.PageSetup.PrintArea = "$A$1:$G$35"
ActiveSheet.PageSetup.Orientation = xlLandscape

Range("G36").Select

If MsgBox("Print endurance statement?", vbYesNo + vbDefaultButton2, "Print endurance") = vbYes Then
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Else
    Range("G36").Select
    End If


End Sub

Et le second sous:

Sub OpenHTML()

On Error GoTo MissingFile

Workbooks.Open FileName:=ThisWorkbook.Path & "\TRICAT Endurance Summary.html"


Exit Sub

MissingFile:

Dim Finfo As String
Dim FilterIndex As Integer
Dim Title As String
Dim FileName As Variant

' Set up list of file filters
Finfo = "HTML Files (*.html),*.html," & _
        "All Files (*.*),*.*,"

' Display *.html by default
    FilterIndex = 1

' Set the dialog box caption
Title = "Select TRICAT Endurance Summary"

' Get the filename
FileName = Application.GetOpenFilename(FInfor, FilterIndex, Title)

' Handle Return info from dialog box
If FileName = False Then
    Call ExitWithoutPrompt
    Else
    MsgBox "You selected" & FileName
    Workbooks.Open FileName

End If

End Sub

Si vous en êtes à ce stade, merci de lire ....

Answer 1

Ajouter un appel à ActiveWorkbook.Fermer à ExitWithoutPrompt :

Sub ExitWithoutPrompt()
    MsgBox "You failed to select a file, therefore Excel will now close.  Please refer to the readme file."
    Excel.Application.DisplayAlerts = False
    Excel.Application.Quit
    ActiveWorkbook.Close False
End Sub

Cela fonctionne pour moi sous Excel 2003.

Pour une raison quelconque, l'ordre d'appeler Application.Quit et ActiveWorkbook.Close est important. De façon contre-intuitive, du moins pour moi, si vous appelez ActiveWorkbook.Close avant Application.Quit , vous obtenez toujours l'erreur.