VBAを使用してExcelを終了すると、ランタイムエラー424が発生する

StackOverflow https://stackoverflow.com/questions/401015

  •  03-07-2019
  •  | 
  •  

質問

ExcelでHTMLドキュメントを開くVBAマクロを作成しています(さまざまな計算を実行するため)。 Excelは、現在のフォルダー内でHTMLドキュメントを検索します。見つからない場合は、ユーザーがHTMLドキュメントの場所を手動で参照できるファイルオープンボックスが生成されます。これまでのところすべて良い。ただし、ユーザーが(ファイルを選択するのではなく)[キャンセル]を選択した場合、Excelでメッセージを表示して終了する必要があります。

メッセージは生成されますが、コードは次のエラーで停止します:

実行時エラー「424」:オブジェクトが必要です。

これはそれほど面倒ではないように聞こえますが、問題の原因を突き止めようと次々とレンガの壁にぶつかりました。

機能しないように見えるサブは:

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

私はMS Excel 2002を使用していますが、できる限り多くのExcelのバリアントに対応できるソリューションを求めています。

私がどこに間違っているのかについて、どんな助けもありがたいことに受け取った。ちなみに私は完全な初心者です。可能な限り、あなたが私のために持っているかもしれないガイダンスを長々とお待ちください...

以下に含まれる有用な可能性がある(この投稿を扱いにくくするリスクがある)は、マクロで使用している他の2つのサブです:

最初のサブ:

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

2番目のサブ:

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

ここまで来たら、読んでくれてありがとう...

役に立ちましたか?

解決

ActiveWorkbook.Close への呼び出しを 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

これはExcel 2003で動作します。

何らかの理由で、 Application.Quit ActiveWorkbook.Close を呼び出す順序が重要です。直感に反して、少なくとも私にとっては、 Application.Quit の前に ActiveWorkbook.Close を呼び出すと、エラーが発生します。

ライセンス: CC-BY-SA帰属
所属していません StackOverflow
scroll top