vba カーソルを砂時計 Escでマクロ中断

Option Explicit

Sub test()

Dim wtTime As Variant
Dim stTime As Date
Dim edTime As Date
Dim i As Long
Dim j As Long
Dim cnt As Long

    Application.EnableCancelKey = xlErrorHandler

    On Error GoTo ErrHandler

   
    cnt = Cells(1, 1)   '10000
   
    'wttime = Now + TimeValue("0:00:10")
    'Application.Wait waitTime

    '砂時計の形状
    Application.Cursor = xlWait
   
    stTime = Now()
   
    ' 無限ループを生成する
    'Do

    'Loop
   
    'ループ
    For i = 1 To cnt
        For j = 1 To cnt
        Next j
    Next i
   
    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