Option Explicit
Sub test()
Dim wtTime As Variant
Dim stTime As Date
Dim edTime As Date
Dim i As Long
Dim j As Long
Application.EnableCancelKey = xlErrorHandler
On Error GoTo ErrHandler
'砂時計の形状
Application.Cursor = xlWait
stTime = Now()
'ループ
For i = 1 To 10000
For j = 1 To 10000
Next j
Next i
' wtTime = Now + TimeValue("0:00:03")
' Application.Wait wtTime
edTime = Now()
'カーソルの形状を元に戻す
Application.Cursor = xlNormal
MsgBox "経過時間=" & Abs(DateDiff("s", stTime, edTime)) & "秒"
Exit Sub
ErrHandler:
'カーソルの形状を元に戻す
Application.Cursor = xlNormal
Select Case Err.Number
Case 18
'Escによる中断
If MsgBox("中断しますか？", vbQuestion + vbYesNo) = vbNo Then
Resume
End If
Case Else
MsgBox "予期しないエラーが発生しました", vbExclamation
End Select
MsgBox "Error No =" & Err.Number & vbCrLf & "Error Msg=" & Err.Description
End Sub