In this instance we will create a Userform that appears when the workbook is first opened, and only stays open for a preset time period, then closes.
It will show a countdown progress bar throughout it's duration so that the user can see when some event is about to occur & depending on what code we put behind the button, can take some action by pressing it.
It can often be really useful to do this, for instance when a workbook has been set to close after a period of inactivity, and you want to give the user an option to delay closure.
Download the already completed ProgressBarUserForm.XLSM file here
Left click anywhere inside the frame, and holding down the left button draw a label anywhere inside the frame. By defaualt this will be named label1 and that is fine.
Click on label1 and in the properties box and change Height to 18, Left to 0, Top to 0, & the Width to 400.
Remove the caption and change the BackColour by selecting from the colour palette option to "&H0000C000&" which is the same green colour as the frame.
Now add a second label. Left click anywhere in the empty space of the UserForm and draw a label. By defaualt this will be named label2 and that is fine.
Click on label2 and in the properties box and change Height to 50, Left to 50, Top to 60, & the Width to 360.
Change the caption to read whatever it is that you need the user to know about. In this Instance we will assume that this Userform is going to be used to warn the user that their workbook is about to close as a result of a timer being set to perform this action in another macro.
Click on Font and Change to size 12 & bold. Click on Text Align and change it to align center.
Add a Command Button See how to do that here
After adding the button (Method explained in the above link), by default the button will be named CommandButton1 and that is fine.
Highlight the command button in the design window and in the properties box Change the caption to give the button a more useful name that will be more related to what you intend the button to do later. here we are simply going to use the button to close the userform, so will change the caption to "CLOSE USERFORM".
Click on Font and Change to size 10 & bold. Then change Height to 30, Left to 150, Top to 130, & the Width to 170.
Below is the code to copy & paste into the userform code window. It is split into three parts that will perform the following actions:-
When the Userform is opened a simple loop code runs that changes the width of label1 in increments of 1 unit every second until it reaches 20 units, and then it will unload itself. ie: it will disappear.
It will also change the colour of the progress bar from green to orange, and then red as it gets close to the end.
When the command button is clicked the userform will close.
When the userform opens the procedure "Hidebar" is called which prevents the userforms border & title bar from showing.
This will remove the minimise,maximise,close buttons & caption and stop your your splash screen looking like some kind of error message box & give it the profesional look you are after.
Private Sub UserForm_Activate()
Label1.Width = 0
w = 0
Do Until w > 400
Label1.Width = w
w = w + 20
DoEvents
Application.Wait Now + TimeValue("00:00:01")
If w > 250 And w < 325 Then
Label1.BackColor = RGB(255, 153, 0)
Frame1.BorderColor = RGB(255, 153, 0)
ElseIf w > 324 Then
Label1.BackColor = vbRed
Frame1.BorderColor = vbRed
End If
Loop
Unload Me
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Remove Border and Title Bar
HideBar Me
End Sub
The code window should now look like this:
Option Explicit
' functions used by the HideBar subroutine below
#If VBA7 Then
Public Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare PtrSafe Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
#Else
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
#End If
Sub HideBar(frm As Object)
'code to hide the title bar on the splash screen
Dim Style As Long, Menu As Long, hWndForm As Long
hWndForm = FindWindow("ThunderDFrame", frm.Caption)
Style = GetWindowLong(hWndForm, &HFFF0)
Style = Style And Not &HC00000
SetWindowLong hWndForm, &HFFF0, Style
DrawMenuBar hWndForm
End Sub
The VB Editor code window should now appear as below.
Just go back again to the Project Explorer Pane in the VB Editor window, double click ThisWorkbook and just as you did in the earlier step when adding the code to the UserForm & module, paste the following code into the window that opens.
Private Sub Workbook_Open()
WarningForm.Show
End Sub
The VB Editor code window should now appear as below.
That's it all done! Now save your workbook making sure to save it with an ".XLSM" macro enabled file extension, close and reopen it to see your progress bar work of art.
