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