How to Display Hourglass Pointer Running Macro in Dialog

MORE INFORMATION

Microsoft Excel version 5.0 does not have a Cursor object; therefore, you cannot change the mouse pointer to an hourglass from a Visual Basic for Applications statement in the macro. The example below demonstrates how to change the mouse pointer in Microsoft Excel for Windows version 5.0 while displaying a dialog box from a Visual Basic for Applications macro in Microsoft Excel version 5.0.

Microsoft provides examples of Visual Basic for Applications procedures for illustration only, without warranty either expressed or implied, including, but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. The Visual Basic procedures in this article are provided 'as is' and Microsoft does not guarantee that they can be used in all situations. While Microsoft Product Support Services (PSS) professionals can help explain the functionality of a particular macro, they will not modify these examples to provide added functionality, nor will they help you construct macros to meet your specific needs. If you have limited programming experience, you may want to consult one of the Microsoft Solution Providers. Solution Providers offer a wide range of fee-based services, including creating custom macros. For more information about Microsoft Solution Providers, call Microsoft Customer Information Service at (800) 426-9400.

Visual Basic Code Example

'This example requires two dialog sheets.
'Dialog #1: "Maindialog" (without the quotation marks)
'Dialog #2: "WaitDialog" (without the quotation marks)

'On Dialog #1, place a button and assign the procedure, "showWaitDialog,"
'(without quotation marks)to the button.
'Set the DismissButton property for the button.

'On Dialog #2, "WaitDialog," assign the frame to the procedure,
'"WaitDialog," (without the quotation marks).

'Run the procedure "main" from a worksheet.
'The procedure "main" will display a dialog box with a button that is
'assigned to the procedure "showWaitDialog" (without the quotation marks).
'Click the button. This will run the procedure "showWaitDialog." When
"WaitDialog" shows, the procedure assigned to the frame will run. The
'procedure "WaitDialog" will run and show the dialog box "WaitDialog." The
'macro assigned to its frame "showWaitDialog" will run, changing the mouse
'pointer and showing the dialog box "WaitDialog."

'Code starts here:

   Option Explicit

   'Declaration for APIs.
   Private Declare Function loadCursor Lib "USER" _
   (ByVal hInstance As Integer, ByVal lpCursorName As Any) _
    As Integer

   Private Declare Function SetCursor Lib "USER" _
   (ByVal hCursor As Integer) As Integer

   'Standard Cursor IDs.
   Private Const IDC_ARROW = 32512&
   Private Const IDC_IBEAM = 32513&
   Private Const IDC_WAIT = 32514&
   Private Const IDC_CROSS = 32515&
   Private Const IDC_UPARROW = 32516&
   Private Const IDC_SIZE = 32640&
   Private Const IDC_ICON = 32641&
   Private Const IDC_SIZENWSE = 32642&
   Private Const IDC_SIZENESW = 32643&
   Private Const IDC_SIZEWE = 32644&
   Private Const IDC_SIZENS = 32645&

   Private oldcursor%, fWaitCursorSet As Boolean

   'This is the main subroutine.
   'This dialog has a button assigned to the procedure "showWaitDialog."
   Sub main()
       Application.DialogSheets("MainDialog").Show
   End Sub

   'This procedure should be assigned to the button on the Dialogsheet
   '"WaitDialog" (without quotation marks).
   Sub showWaitDialog()
     Application.DialogSheets("WaitDialog").Show
   End Sub

   'This sub uses APIs to change the mouse pointer.
   Sub SetWait(fSetWaitCursor As Boolean)
    'If they have not set the cursor to wait, do not try to un-set it.
    If fSetWaitCursor Then
      oldcursor% = SetCursor(loadCursor(0, IDC_WAIT))
       fWaitCursorSet = True
     ElseIf Not fSetWaitCursor And fWaitCursorSet Then
       SetCursor oldcursor%
       fWaitCursorSet = False
      End If
   End Sub

   'Assign this procedure to the frame of the Dialogsheet "WaitDialog"
   '(without the quotation marks).

   Sub WaitDialog()
     Application.SendKeys ("~")
    MsgBox "This does not show"

   'This line changes the mouse pointer to an Hour Glass.
    SetWait (IDC_WAIT)

    'Put your procedure here in place of TestLoop.
    TestLoop
    SetWait (IDC_ARROW)
    Application.DialogSheets("WaitDialog").Hide
    End Sub

   Sub TestLoop()
   Dim x As Integer
     For x = 1 To 200
     ActiveCell.Value = x
     ActiveCell.Offset(1, 0).Select
     Next x
   End Sub