VBA - User Form show at start of macro & hide at the end

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
754
Hi,

I have a user form(UserForm1) which I want to show at the start of the maro & hide at the end i.e. when the macro/code is completed.

The purpose for this is that some codes do take few seconds to complete so I would want a user form (stating some text like the macro is ruuning - pls wait etc) to display on the screen unless the code is complete - which would let the user know that the code is running.

Any help would be appreciated.

Regards,

Humayun
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,909
.
This macro is for demonstration purposes only. Simulates your FORM being displayed and something happening
while that form is viewed.

Code:
Option Explicit
Dim TimeToRun


Sub ScheduleCopyPriceOver()


    If Sheet1.Range("D10").Value = 10 Then
        Sheet1.Range("D10").Value = 0
        auto_close
        Exit Sub
    End If
    
    UserForm1.Show
    TimeToRun = Now + TimeValue("00:00:01")
    Application.OnTime TimeToRun, "CopyPriceOver"
End Sub


Sub CopyPriceOver()
    Calculate
    Sheet1.Range("D10").Value = Range("D10").Value + 1
    Call ScheduleCopyPriceOver
End Sub


Sub auto_close()
    On Error Resume Next
    Application.OnTime TimeToRun, "CopyPriceOver", , False
    UserForm1.Hide
End Sub

Note the comments on the USERFORM and on the sheet.

Download : https://www.amazon.com/clouddrive/share/I5s6Oo4Oa0JwNfJtAH2KUARyUlYeqXyqy6rOlw9WSBP
 

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
754
Thanks.... I found a solution while searching net.


Code:
Sub showform()
UserForm1.Show (vbModeless)
UserForm1.Repaint
End Sub

setting it to vbModeless will make it appear on the screen & your macro will be running in background

Code:
Sub hideform()
UserForm1.Hide
End Sub



Code:
Sub update

UserForm1.Show

Call mymacro

UserForm1.Hide

End Sub

Only problem remains is the top of the userform changes its colour to white while the macro is running.

Do you have any idea ???
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,909
.
Paste all of this inside the UserForm. It will remove the menu bar, borders and still allow you to move the form around the screen
on Rt Click and Hold.

Code:
Option Explicit


'**** Start of API Calls To Remove The UserForm's Title Bar ****




[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32"
                Alias "FindWindowA" _
               (ByVal lpClassName As String, _
                ByVal lpWindowName As String) As Long
  


    Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                Alias "GetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long) As Long
  


    Private Declare PtrSafe Function SetWindowLong Lib "user32" _
                Alias "SetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long
  


    Private Declare PtrSafe Function DrawMenuBar Lib "user32" _
               (ByVal hWnd As Long) As Long
'**** End of API Calls To Remove The UserForm's Title Bar ****


'**** Start of API Calls To Allow User To Slide UserForm Around The Screen ****
    Private Declare PtrSafe Function SendMessage Lib "user32" _
                Alias "SendMessageA" _
               (ByVal hWnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long
 
    Private Declare PtrSafe Function ReleaseCapture Lib "user32" () As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
   Private Declare Function FindWindow Lib "user32" _
                Alias "FindWindowA" _
               (ByVal lpClassName As String, _
                ByVal lpWindowName As String) As Long
  


    Private Declare Function GetWindowLong Lib "user32" _
                Alias "GetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long) As Long
  


    Private Declare Function SetWindowLong Lib "user32" _
                Alias "SetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long
  


    Private Declare Function DrawMenuBar Lib "user32" _
               (ByVal hWnd As Long) As Long
'**** End of API Calls To Remove The UserForm's Title Bar ****


'**** Start of API Calls To Allow User To Slide UserForm Around The Screen ****
    Private Declare Function SendMessage Lib "user32" _
                Alias "SendMessageA" _
               (ByVal hWnd As Long, _
                ByVal wMsg As Long, _
                ByVal wParam As Long, _
                lParam As Any) As Long
 
    Private Declare Function ReleaseCapture Lib "user32" () As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
'**** End of API Calls To Allow User To Slide UserForm Around The Screen ****


Dim hWndForm As Long


Private Sub CommandButton1_Click()
    Unload Me
End Sub


Private Sub UserForm_Initialize()
   Dim Style As Long, Menu As Long
   hWndForm = FindWindow("ThunderDFrame", Me.Caption)
   Style = GetWindowLong(hWndForm, &HFFF0)
   Style = Style And Not &HC00000
   SetWindowLong hWndForm, &HFFF0, Style
   DrawMenuBar hWndForm
End Sub


Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  If Button = xlPrimaryButton And Shift = 1 Then
    Call ReleaseCapture
    Call SendMessage(hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&)
  End If
End Sub
 

Forum statistics

Threads
1,078,491
Messages
5,340,683
Members
399,389
Latest member
JayNExcel

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top