Excel Trial Dialog, Create An Excel VBA UserForm With Information Icon And Timer Enabled OK Button

OK, so let’s begin. We will set up the UserForm and then add in the VBA Code. First Open Excel and press ALT+F11 to enter the VBA Editor. Go to the File Menu and choose Insert–>UserForm. Name the new UserForm MsgBoxCountdown and set its Height property to 132 and its Width property to 242. Add one Label to the UserForm and name it lbTrialMsg (set its Caption property to ” This Message only appears in the Trial Version of XXXX” without the quotes) – this will be our Trial or Nag Message to the user. We will prefix this Caption with a passed in bespoke Message. Add one further Label to the UserForm and name it lbCountDown (set its Caption property to “This Trial Dialog can be closed in” without the quotes) – this will be our Countdown Message to the user. Now add an Image Control and load in an image resembling a Question Mark – you can easily create or adopt an image for this purpose. Finally add a Command Button and name it btnOK, set its Caption to OK – this will be the button that will be disabled until the timer interval has elapsed and the user is allowed to press it.

Tip: Why not add a Frame Control just over half the Height and the full Width of the UserForm to hold the lbCountDown Label and btnOK Button and then set the BackColour of the UserForm itself to &H80000005& – this divides the UserForm giving it a really pleasing aesthetic quality

You should now have a nice looking UserForm and be in a position to add in the VBA Code. Double-click your OK Button to enter the VBA Code Editor for the UserForm Module. Amend the Subroutine generated to the following Code – you can paste over it if preferred:

‘=================================

‘ btnOK_Click, closes the UserForm

‘=================================

Private Sub btnOK_Click()

Unload Me

End Sub

Now add the following Code at the top of the Module – these are the Windows API’S we will be using to re-style the Dialog Window and the Interval Variable that we have set to 5 (seconds) before we enable the OK Button:

Option Explicit

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

Const WS_SYSMENU = &H80000

Const GWL_STYLE = (-16)

‘===============================================================

‘ Interval, set this to the time before the OK Button is enabled

‘===============================================================

Private Const Interval = 5

OK, next we will add the UserForm QueryClose Event Handler. This can be used to simply trap a Close attempt on the Red Cross if you don’t want to remove it when we get to the UserForm Activate Event Handler in a minute. So add the following Code:

‘==============================================================================

‘ UserForm_QueryClose, workaround if you don’t want to hide the Red Close Cross

‘==============================================================================

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

On Error GoTo QueryCloseErrorHandler

Application.EnableCancelKey = xlErrorHandler

If CloseMode = 0 Then

Cancel = True

MsgBox “Oops, the X in this Dialog has been disabled, please use the OK Button on the form”, vbCritical, “Kiosk 4.1”

End If

Exit Sub

QueryCloseErrorHandler:

Resume Next

End Sub

Nearly there, now we need to add in the UserForm Activate Event Handler Code. This is the work-horse of the VBA Code and I will go through it in a minute. Anyhow, add in the following Code (you can please yourself whether you add in the comments):

‘============================================================================

‘ UserForm_Activate, strange little error handling routine, it goes…

‘ – style the userform to remove the red cross

‘ – add a restart point for hack attacks

‘ – set up an error handler & tell excel to use it

‘ – disable the OK Button

‘ – start the countdown

‘ – on hack (CTR+Break) goto restart – that will begin the whole process over

‘ – if time up enable OK Button, OK will Unload the UserForm

‘ – in the interim DoEvents will allow you to still move the Dialog

‘============================================================================

Private Sub UserForm_Activate()

On Error Resume Next

Dim hwnd, lStyle As Long

hwnd = FindWindow(“ThunderDFrame”, Me.Caption)

lStyle = GetWindowLong(hwnd, GWL_STYLE)

SetWindowLong hwnd, GWL_STYLE, lStyle And Not WS_SYSMENU

Me.lbTrialMsg.Caption = Me.Tag & Me.lbTrialMsg.Caption

restart:

err.Clear

On Error GoTo TrialErrorHandler

Application.EnableCancelKey = xlErrorHandler

Me.btnOK.Enabled = False

Dim t As Single

t = Timer

Do

DoEvents

If err.Number = 18 Then GoTo restart

If Round(t + Interval – Timer, 0) > 0 Then

If err.Number = 18 Then GoTo restart

Me.lbCountDown.Caption = “This Trial Dialog can be closed in ” & Round(t + Interval – Timer, 0)

Else

If err.Number = 18 Then GoTo restart

Me.lbCountDown.Caption = “”

End If

Loop While t + Interval > Timer

Me.btnOK.Enabled = True

Exit Sub

TrialErrorHandler:

Resume Next

End Sub

The first part of the Code tells Excel that if it hits an error to skip over regardless of what error has occurred. Not normally good practice but we do not want the Excel Debug box to ever be made available to a user. We then style the Dialog Window to remove the red cross Close Button using the Windows API calls. NB: For Office 2000 and later we use the class name ThunderDFrame (for Office 97, it isThunderXFrame). The lbTrialMsg Caption is then set to incude the UserForm Tag message that we set before we show the UserForm plus the message we set earlier. In other words we can call this UserForm from anywhere in our Application passing in a Key Relevant Message that is prefixed onto our pre-set one. We then add a Goto point called restart: This will be where we jump to when a user presses the CTRL+Break Keystroke combination. This also sets up Excel to use another Goto point for our Error Handling and then tells Excel that we wish to only use that point for all errors whatever they may be. Next we disable the OK Button. We set the variable ‘t’ to the current Timer time and begin looping until our interval has expired – the interval variable was set to 5 (seconds) earlier. In the interim we use DoEvents to allow the Dialog to be moved around and the lbCountDown Caption to be updated with our Countdown Message. When the interval expires we then clear the lbCountDown Caption. At the same time we still trap the CTRL+Break Keystroke combination and then enable the OK Button as the flow moves out of the Do loop. We then exit the Subroutine. Used in conjunction with some VBA Module protection you have a useful little Countdown Message / Nag Dialog. If you don’t want to re-style the Dialog Window, simple removed the API’S and allow the UserForm QueryClose Event Handler to trap the Red Close Cross.

OK, finally, double-click the ThisWorkbook Module and enter the following:

Option Explicit

‘=================================================================

‘ DemonstrateMsgBoxCountdown, run this to see the Countdown Dialog

‘=================================================================

Public Sub DemonstrateMsgBoxCountdown()

MsgBoxCountdown.Tag = “(YOU CLICKED A FEATURE):”

MsgBoxCountdown.Show

End Sub

OK, now choose Debug–>Compile VBAProject to compile your Code and check for any errors. Click anywhere in the Code you entered above and press F5 to Run the Sub/UserForm. You should see your UserForm appear. Try pressing Ctrl+Break and watch the Timer interval increase back up to 5 seconds. That’s it. Feel free to download the MsgBox Countdown example Workbook from the links below. I hope you liked this article on Creating a UserForm with Countdown, Information Icon and Timer Enabled OK Button in VBA for Excel. Mark Kubiszyn.



Source by Mark Kubiszyn

%d blogger menyukai ini: