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 ....
La solution
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.