Full Code Listing for Wizdemo.xls
Module Code
Option Explicit
Const gszEXPLAIN = "The Property Get procedure in" & _
" the frmWizardDialog allows us to get" & _
" information from the UserForm."
Const gszADDRESS_R1C1 = "For example: The range" & _
" selected in step 2 (in R1C1 notation) is: "
Const gszPROPERTY_GET_TITLE = "WizDemo: Getting info" & _
" from the Object Module"
Const gszSEE_SDK = "See the Wizard section in the" & _
" Microsoft Excel SDK for details."
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: ShowWizard
''' Comments: Assigned to the Show Wizard Demo command
''' button. Starts the demo. Calls the
''' bWizardRun code in the UserForm Object
''' Module to run the Wizard
''' Date Developer Action
''' -----------------------------------------------------
'''
Sub ShowWizard(Optional bDeveloper As Boolean = False)
''' name of new worksheet
Dim wksNewSheet As Worksheet
''' Add a temporary worksheet for demo
Set wksNewSheet = ThisWorkbook.Worksheets.Add
''' Initialize the appearance of the wizard dialog
''' based on whether it's run by user or a developer.
If bDeveloper Then
frmWizardDialog.Width = 286.2
frmWizardDialog.mpgWizardControl.Style = _
fmTabStyleTabs
Else
frmWizardDialog.Width = 245
frmWizardDialog.mpgWizardControl.Style = _
fmTabStyleNone
End If
''' Call Object Module routine to Show the wizard
If frmWizardDialog.bWizardRun Then
''' Wizard was NOT cancelled.
''' Procedure continues here...
''' Demo the Property Get from the Object Module
''' Get the Range user provided in Step 2
MsgBox gszEXPLAIN & Chr(13) & Chr(13) & _
gszADDRESS_R1C1 & Chr(13) & _
frmWizardDialog.szSelectedRangeR1C1 & _
Chr(13) & Chr(13) & gszSEE_SDK, vbOKOnly + _
vbInformation, gszPROPERTY_GET_TITLE
''' more processing here if needed...
''' After your procedure runs, remove the
''' UserForm from memory
Unload frmWizardDialog
Else ''' User cancelled the wizard
''' don't ask me when deleting the demo sheet
Application.DisplayAlerts = False
wksNewSheet.Delete ''' delete temp worksheet
End If
End Sub
UserForm Code
Option Explicit
Const miMAX_PAGE_INDEX As Integer = 2
Const mszBASE_DIALOG_CAPTION As String = _
"Cell Entry Wizard - Step "
Const mszNO_HELP As String = "Sorry - Help is not" & _
" implemented in the demo but should be in a" & _
" real Wizard."
Const mszNO_HELP_TITLE As String = "Are you kidding?"
Const mszERROR_TITLE As String = _
"Wizard Validation Error"
Const mszBAD_SELECTION As String = _
"Sorry, your selection is not valid."
Const mszNAME_TOO_SHORT As String = _
"Sorry, your name must be 3 or more characters."
Dim miCurrentStep As Integer
Dim mbUserCancelled As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Property Get: szSelectedRangeR1C1
''' Arguments: None
''' Comments: Property Get allows you to get
''' information from the Object Module in
''' other modules. This example takes the
''' range the user selects in step 2 of the
''' wizard and converts the range to R1C1
''' notation if needed. This string is
''' displayed in a message box called in
''' the mEntry module.
'''
''' To use this new property, use the
''' following syntax:
''' frmWizardDialog.szSelectedRangeR1C1( _
''' UserFormName.Property)
''' IMPORTANT: This property is NOT available
''' after the form has been unloaded.
''' Date Developer Action
''' -----------------------------------------------------
'''
Property Get szSelectedRangeR1C1() As String
''' Create an address string in R1C1 notation.
With Application
If .ReferenceStyle = xlA1 Then ''' convert
szSelectedRangeR1C1 = .ConvertFormula( _
refEntryRange, xlA1, xlR1C1)
Else
szSelectedRangeR1C1 = refEntryRange.Text
End If
End With
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Function: bWizardRun
''' Returns: True if user completes the Wizard
''' Comments: Shows the Wizard and Unloads it if the
''' user cancels
''' Date Developer Action
''' -----------------------------------------------------
'''
Public Function bWizardRun() As Boolean
''' initialize the Wizard assuming user will cancel
mbUserCancelled = True
frmWizardDialog.Show
bWizardRun = Not mbUserCancelled
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: cmdNext_Click
'''
''' Comments: Moves the wizard one step forward from
''' the current step.
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub cmdNext_Click()
''' Validate the entries on the current step before
''' moving forward.
If bValidate(miCurrentStep) Then
''' Increment the module-level step variable and
''' show that step.
miCurrentStep = miCurrentStep + 1
mpgWizardControl.Value = miCurrentStep
''' Initialize wizard controls for the new step
InitWizard (miCurrentStep)
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: cmdBack_Click
''' Comments: Moves the wizard one step backward from
''' the current step.
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub cmdBack_Click()
''' Decrement the module-level step variable and
''' display that step.
miCurrentStep = miCurrentStep - 1
mpgWizardControl.Value = miCurrentStep
''' Initialize the wizard controls for the new step
InitWizard (miCurrentStep)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: cmdCancel_Click
'''
''' Comments: Dismisses the wizard dialog without
''' continuing.
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub cmdCancel_Click()
''' Hide the wizard dialog.
Me.Hide
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: cmdFinish_Click
'''
''' Comments: Dismisses the wizard dialog and completes
''' the task.
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub cmdFinish_Click()
''' Run the validation code. In Demo this is NOT
''' needed, but all sheets should run routine
If bValidate(miCurrentStep) Then
''' hide the Wizard, you may need to refer to a
''' control from code.
Me.Hide
''' set cancelled flag
mbUserCancelled = False
''' Call routine to do the work of the wizard
WriteCellEntry
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: cmdHelp_Click
''' Comments: In a production app would call the help
''' system. Not implemented in the demo.
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub cmdHelp_Click()
MsgBox mszNO_HELP, vbInformation + vbOKOnly, _
mszNO_HELP_TITLE
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: txtCellEntry_Change
''' Comments: Enables the Next button if an entry has
''' been made in the textbox.
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub txtCellEntry_Change()
If txtCellEntry.Text = "" Then
cmdNext.Enabled = False
cmdNext.Default = False
Else
cmdNext.Enabled = True
cmdNext.Default = True
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: refEntryRange_Change
''' Comments: Enables the Next button if the box
''' contains text (the bValidate
''' routine validates the range.
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub refEntryRange_Change()
If refEntryRange.Text = "" Then
cmdNext.Enabled = False
cmdNext.Default = False
Else
cmdNext.Enabled = True
cmdNext.Default = True
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: UserForm_Initialize
''' Comments: Initializes the module-level step
''' variable and shows the first step.
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub UserForm_Initialize()
''' call common init routine
InitWizard
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Function: bValidate
''' Comments: Used to validate a single page or all
''' pages of the Wizard. In WizDemo the -1
''' flag (all pages) is NOT used, but would
''' be if you were validating all pages when
''' the finish button is chosen. There are 2
''' major sections:
''' SECTION 1: Code for All Pages Only
''' SECTION 2: Code for each page of Wizard.
''' Arguments: iValidatePage - validate the page passed
''' (0 based index) If nothing is passed,
''' default is: validate all pages (-1)
''' Returns: True if the page validates
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Function bValidate(Optional iValidatePage As _
Integer = -1) As Boolean
Dim bIsAllPages As Boolean ''' true if -1 is passed
Dim szTrash As String ''' Holds temp values
''' Set function to True. If any validation doesn't
''' pass it will be changed to False.
bValidate = True
''' set IsAll flag if -1 is passed.
bIsAllPages = iValidatePage = -1
''' SECTION 1
If bIsAllPages Then
''' placeholder for additional coded needed if
''' dialog is being validated as a batch process
''' when Finish button is pressed.
End If
''' SECTION 2 if page 1 or all pages (-1)
If iValidatePage = 0 Or bIsAllPages Then
If Len(txtCellEntry.Text) < 3 Then
MsgBox mszNAME_TOO_SHORT, vbOKOnly + _
vbExclamation, mszERROR_TITLE
txtCellEntry.SetFocus
bValidate = False
End If
End If
''' page 2 or all pages
If iValidatePage = 1 Or bIsAllPages Then
''' Turn off error handling while testing range.
On Error Resume Next
With Application
If .ReferenceStyle = xlR1C1 Then
szTrash = .ConvertFormula( _
refEntryRange, xlR1C1, xlA1)
''' the next statement will error if the
''' selection isn't a valid range
szTrash = .Range(szTrash).Address
Else
''' the next statement will error if the
''' selection isn't a valid range
szTrash = .Range(refEntryRange).Address
End If
End With
If Err <> 0 Then
''' will only happen if range is not valid
MsgBox mszBAD_SELECTION, vbOKOnly + _
vbExclamation, mszERROR_TITLE
refEntryRange.SetFocus
bValidate = False
End If
''' reinstate standard error handling
On Error GoTo 0
''' In a production app,
''' reinstate custom error handler
End If
''' if page 3 or all pages (-1)
If iValidatePage = 2 Or bIsAllPages Then
''' Page 3 validation goes here...
''' no validation needed in WizDemo
End If
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: InitWizard
''' Arguments: iInitPage - Integer: Page being
''' initialized (-1 is special
''' case: First time dialog
''' displayed)
''' Comments: Initializes all pages of the wizard
''' Contains 4 Initialize sections:
''' SECTION 1: Before initial dialog display
''' (iInitPage = -1)
''' SECTION 2: Before any page is displayed
''' EXCEPT the first time
''' SECTION 3: Common code on any page
''' display, no exceptions
''' SECTION 4: Page specific code
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub InitWizard(Optional iInitPage As Integer = -1)
''' SECTION 1: Before initial dialog display
If iInitPage = -1 Then
''' Set the module-level step variable, set to
''' first page of the MultiPage control.
miCurrentStep = 0
mpgWizardControl.Value = miCurrentStep
cmdBack.Enabled = False
cmdNext.Enabled = False
cmdNext.Default = False
cmdFinish.Enabled = False
''' SECTION 2: Before any page EXCEPT initial display
Else
If miCurrentStep = miMAX_PAGE_INDEX Then
''' final page
cmdFinish.Default = True
cmdNext.Enabled = False
Else
cmdFinish.Enabled = False
cmdFinish.Default = False
End If
If miCurrentStep > 0 Then
''' not first page
cmdBack.Enabled = True
Else
cmdBack.Enabled = False
End If
End If
''' SECTION 3: Common code for all displays
''' Set dialog caption
Me.Caption = mszBASE_DIALOG_CAPTION & miCurrentStep _
+ 1 & " of " & miMAX_PAGE_INDEX + 1
''' SECTION 4: Code for page specific initialization
''' if -1 (first time), handled as special case above
Select Case iInitPage
Case 0 ''' Page 1
If txtCellEntry.Text = "" Then
cmdNext.Enabled = False
Else
cmdNext.Enabled = True
End If
Case 1 ''' Page 2
If refEntryRange.Text = "" Then
cmdNext.Enabled = False
cmdNext.Default = False
Else
cmdNext.Enabled = True
cmdNext.Default = True
End If
refEntryRange.SetFocus
Case 2
''' Page 3 (none in this example)
End Select
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Subroutine: WriteCellEntry
''' Comments: Enables the Next button if the box
''' contains text (the bValidate
''' routine validates the range).
''' Date Developer Action
''' -----------------------------------------------------
'''
Private Sub WriteCellEntry()
Dim sCellEntry As String
Dim bBold As Boolean
Dim bItalic As Boolean
Dim bUnderlined As Boolean
Dim rngSelection As Range
''' Grab the text entry from the step 1 text box.
sCellEntry = txtCellEntry.Text
''' Create an object reference to the selected range
''' from step 2
With Application
If .ReferenceStyle = xlR1C1 Then ''' convert
Set rngSelection = .Range(.ConvertFormula( _
refEntryRange, xlR1C1, xlA1))
Else
Set rngSelection = .Range(refEntryRange.Text)
End If
End With
''' Get the font options chosen in step 3.
bBold = chkBold.Value
bItalic = chkItalic.Value
bUnderlined = chkUnderlined.Value
''' Error handler here in case of failure
''' Make the entry
With rngSelection
.Value = sCellEntry
With .Font
.Bold = bBold
.Italic = bItalic
.Underline = bUnderlined
End With
End With
End Sub