Changing The MousePointer With Class


--------------------------------------------------------------------------------

Here is a way to change the default MousePointer to an Hourglass and automatically restore it back to the original state whether procedure ends normally or crashes in the middle. This class is easy to use:

Sub AProcedure()

Dim Hourglass As New HourglassObject

Hourglass.DisplayCursor

' *** your procedure code here...

End Sub

Class Code

BEGIN

MultiUse = -1 'True

END

Attribute VB_Name = "clsHourglass"

Attribute VB_Creatable = True

Attribute VB_Exposed = True

Option Explicit



Private mMousePointer As Long



Public Sub DisplayCursor(Optional SubstitutePointer As Variant)

' *** We display a cursor ***

mMousePointer = Screen.MousePointer

If IsMissing(SubstitutePointer) Then

' *** Default to Hourglass ***

Screen.MousePointer = vbHourglass

Else

' *** Substitute with your own pointer if needed ***

Screen.MousePointer = SubstitutePointer

End If

End Sub



Private Sub Class_Terminate()

' *** Restore pointer ***

Screen.MousePointer = mMousePointer

End Sub