https://qiita.com/fuk101/items/aa12f4934e5cc3eba296
エラーが発生していないときにResumeは実行できない
-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する
-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行
Private Sub CommandButton1_Click()
On Error GoTo UNHANDLE
'確認メッセージを表示しない
Application.DisplayAlerts = False
'画面を更新しない
Application.ScreenUpdating = False
'自動計算しない
Application.Calculation = xlCalculationManual
''Dim i As Long
''i = 1 / 0
If main() = False Then
GoTo FINALLY
End If
MsgBox "処理完了"
GoTo FINALLY
'ハンドル外例外
UNHANDLE:
MsgBox Err.Description & "[" & Err.Number & "]"
'ハンドル例外
'最終処理
FINALLY:
'確認メッセージを表示する
Application.DisplayAlerts = True
'画面を更新する
Application.ScreenUpdating = True
'自動計算する
Application.Calculation = xlCalculationAutomatic
End Sub
Private Function main() As Boolean
main = False
Dim wb As Workbook
Dim sh As Worksheet
Set wb = Workbooks.Add
Set sh = wb.Worksheets(1)
'数式をセルに設定する
Dim i As Long
For i = 1 To 10000
sh.Range("A" & CStr(i)).Value = CStr(Int(100 * Rnd) + 1)
sh.Range("B" & CStr(i)).Value = CStr(Int(100 * Rnd) + 1)
sh.Range("C" & CStr(i)).Formula = "=" & "A" & CStr(i) & "/" & "B" & CStr(i)
Next i
''i = 1 / 0
If Dir(ThisWorkbook.Path & "\test.xlsx") <> "" Then
MsgBox "ファイルが存在します"
wb.Close
Exit Function
End If
wb.SaveAs Filename:=ThisWorkbook.Path & "\test.xlsx"
wb.Close
main = True
End Function
