Hourglass routine help from an old class module

I have an old hourglass routine i found on the net.

What I need:
I would to Change the cursor to  "Aero_Working_xl.ani"

AND
after defining the specific cursor change.
I need help in properly calling this procedure.

Thanks
fordraiders








'----------------------------------------------------------------------
' DESCRIPTION: Class Module clshourglassXL
'-------------
'This class not only provides the SetCursor method, which provides a 
' convenient method of setting the hourglass cursor, but it automatically
' restores the cursor when the class object is destroyed.
'
'Although you can call the Restore method to restore the cursor, it is not
' necessary.  Using clsHourglassXL guarantees the cursor will be restored
' when the subroutine terminates, even if the subroutine terminates due 
' to an unhandled run-time error!
'----------------------------------------------------------------------
' HISTORY:
'---------
' Adapted from Access VBA
'----------------------------------------------------------------------
' INPUT:
'-------
'    cCursor.setCursor
'     OR
'    cCursor.Restore
'----------------------------------------------------------------------
' OUTPUT:
'--------
' Changes the cursor hourglass
'----------------------------------------------------------------------
' SAMPLE CALL:
'-------------
'Declare your clsHourglassXL object within a subroutine:
'
'Sub Eyeglass()
'    Dim cCursor As New clsHourGlassXL
'    cCursor.SetCursor
'Stop
'    cCursor.Beam
'Stop
'    cCursor.Arrow
'Stop
'     'Perform lengthy tasks here
'     cCursor.Restore
' End Sub
'----------------------------------------------------------------------'DECLARATIONS:
'-------------
Option Explicit
#Const DEBUG_ = False                  ' Set to False for Release version or True for Development
Private Const C_MODULE_NAME = "clsHourGlassXL"
Private mintOldPointer As Integer ' Save Current Pointer State
Private Sub Class_Initialize()
    On Error Resume Next
    '  Save current mouse pointer
    mintOldPointer = Application.Cursor
    '  Change to hourglass
    Application.Cursor = xlWait 'vbHourGlass
End Sub
Private Sub Class_Terminate()
Const C_PROC_NAME = "Class_Terminate"
    Restore
End Sub
Public Sub SetCursor()
Const C_PROC_NAME = "SetCursor"
    ' Set mouse pointer to hourglass/wait state.
    Application.Cursor = xlWait
End Sub
Public Sub Restore()
Const C_PROC_NAME = "Restore"
    ' Return mouse pointer to normal display.
    Application.Cursor = xlDefault
End Sub
Public Sub Beam()
Const C_PROC_NAME = "Beam"
    ' Set mouse pointer to IBeam display.
    Application.Cursor = xlIBeam
End Sub
Public Sub Arrow()
Const C_PROC_NAME = "Arrow"
    ' Set mouse pointer to NorthWestArrow display.
    Application.Cursor = xlNorthwestArrow
End Sub

Open in new window

LVL 3
FordraidersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Roy CoxGroup Finance ManagerCommented:
I don't believe you need that code to achieve what you want. Try this

Option Explicit

Sub Main()

    Dim lLoop As Long
    ''/// routine would include actual code you want to run
    With Application
        .Cursor = xlWait
        For lLoop = 1 To 99999
            Application.StatusBar = "Processing " & Format(lLoop / 99999, "0%")
            DoEvents
        Next
        .StatusBar = ""
        .Cursor = xlDefault
    End With
End Sub

Open in new window


I believe the "aero_working_xl.ani" cursor has replaced the Hourglass in newer versions of Office
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FordraidersAuthor Commented:
Thanks !!
0
Roy CoxGroup Finance ManagerCommented:
No problem
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.