Adding loading effects into userform click event

[bradyboyy88]

Is there a windows API call to use the windows 8 ( not sure if its used in other versions of windows) circular loading symbol that occurs when clicking on a file or copying, etc in a userform. I want to initiate this to show there is loading taking place in the userform event. Another idea was to add a loading bar to the userform window frame but that seemed like it would be a bit more difficult.

 

[Jan Mach]

Try to set an adequate MousePointer property for the control that runs a space-wasting macro.

 

[Jaafar Tribak]

In my Windows10 edition, I found the cursor in the C:\Windows\Cursors folde under the names of :
aero_busy.ani
aero_busy_l.ani
aero_busy_xl.ani

However when trying to set the userform mouse icon to one of the above ani files, none of the .ani files come up in the cursors dialogbox.

I guess (not sure) one could use the LoadImage API with the LR_LOADFROMFILE flag set and then use the SetCursor api function to achieve what you want.

What operation with the userform are you carrying out that needs waiting ?

 

[bradyboyy88]

In my Windows10 edition, I found the cursor in the C:\Windows\Cursors folde under the names of :
aero_busy.ani
aero_busy_l.ani
aero_busy_xl.ani

However when trying to set the userform mouse icon to one of the above ani files, none of the .ani files come up in the cursors dialogbox.

I guess (not sure) one could use the LoadImage API with the LR_LOADFROMFILE flag set and then use the SetCursor api function to achieve what you want.

What operation with the userform are you carrying out that needs waiting ?

I do a bunch of ADO queries queries to an access database which take some time and there are also additional vba subroutines that are being run as well. I didnt really think much about this until giving a presentation and everyone was waiting for the button to do something and it was running but it was hard to tell. So having the circular loading cursor would be great while a macro is running.

@Jon Mach: The mouse pointer property would just set it to the appropriate one for the hover over that one control.

 

[Jaafar Tribak]

I do a bunch of ADO queries queries to an access database which take some time and there are also additional vba subroutines that are being run as well. I didnt really think much about this until giving a presentation and everyone was waiting for the button to do something and it was running but it was hard to tell. So having the circular loading cursor would be great while a macro is running.

@Jon Mach: The mouse pointer property would just set it to the appropriate one for the hover over that one control.

Have you considered using something like this
UserForm1.MousePointer = fmMousePointerHourGlass

It is not the circular loading cursor but it is close.

 

[Jaafar Tribak]

I remember writing this Class which you can use to create a mouse pointer that displays a text of your choice instead of a cursor .. You may find it useful for the scenario you have described... Text can get the user's attention and inform them of what is happening. Much better than staring at a hourglass and wondering if the program is running or hung up.

In case you have 64bit excel then the class code won't work as I never updated it... I may do so later.

 

[bradyboyy88]

I remember writing this Class which you can use to create a mouse pointer that displays a text of your choice instead of a cursor .. You may find it useful for the scenario you have described... Text can get the user's attention and inform them of what is happening. Much better than staring at a hourglass and wondering if the program is running or hung up.

In case you have 64bit excel then the class code won't work as I never updated it... I may do so later.

Yea I may go with the hour glass for ease, your custom class you made though is an interesting idea though too. I may have to mess with that a bit. replacing it with text might not be a bad idea. When the cursor is replaced can the user still click on stuff?

 

[Jaafar Tribak]

Also, if you have the following aero cursor in your system like I do , you may want to try this simpler approach :

Note : You may have to change your ani cursor path in the code below: (C:\Windows\Cursors\aero_busy_xl.ani) as needed

Option Explicit

Type POINTAPI
    x As Long
    y As Long
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Declare PtrSafe Function GetCursor Lib "user32" () As LongPtr
    Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As LongPtr) As LongPtr
    Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Declare Function GetCursor Lib "user32" () As Long
    Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
    Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Const LR_LOADFROMFILE = &H10

Sub Test()
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim hCursor As LongPtr, hTempCursor As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim hCursor As Long, hTempCursor As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

    Dim tCurPos As POINTAPI
    Dim sngTimer As Single

    hCursor = GetCursor
    hTempCursor = LoadImage(0, "C:\Windows\Cursors\aero_busy_xl.ani", 2, 128, 128, LR_LOADFROMFILE)
    sngTimer = Timer
    Do
        SetCursor hTempCursor
        GetCursorPos tCurPos
    Loop Until Timer - sngTimer >= 5 [B][COLOR=#008000]'<== loop for 5 seconds[/COLOR][/B]
    SetCursor hCursor
    SetCursorPos tCurPos.x, tCurPos.y + 1
End Sub