第20章 构件用户窗体

20.1 用户窗体开发特性 

20.2 预览一个简单窗体

 

代码清单20.1: 简单的窗体,简单的代码

 

代码

'代码清单20.1: 简单的窗体,简单的代码
Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    SaveSheetName
    Unload Me
End Sub

Private Sub SaveSheetName()
    On Error Resume Next
    ActiveSheet.Name = txtActiveSheet.Text
End Sub

Private Sub UserForm_Initialize()
    txtActiveSheet.Text = ActiveSheet.Name
    
    'Pre-select all of the text in the text box.
    txtActiveSheet.SelStart = 0
    txtActiveSheet.SelLength = Len(txtActiveSheet.Text)
End Sub

 

 

20.3 窗体意味着需要显示

20.3.1 先显示，再提问

代码清单20.2: 使用Show方法显示窗体

 

代码

'代码清单20.2: 使用Show方法显示窗体
Sub SimpleFormExample()
    'Show form modally
    ShowSimpleForm True    
    MsgBox "ok - same form now, but modeless.", vbOKOnly

 

    'Show form modeless　　
    ShowSimpleForm False    
    MsgBox "Exiting the simpleFormExample procedure.", vbOKOnly
End Sub

'display the simple form
Sub ShowSimpleForm(bModal As Boolean)
    If bModal Then
        frmSimpleForm.Show vbModal
    Else
        frmSimpleForm.Show vbModeless
    End If
End Sub

 

20.3.2 装入和现实

代码清单20.3: 在显示之前向内存装入一个窗体

 

代码

'代码清单20.3: 在显示之前向内存装入一个窗体
'Modify the simple form before showing it
Sub ModifySimpleForm()
    Dim sNewCaption As String    
    'Load the form into memory
    Load frmSimpleForm    
    'Prompt for a new caption
    sNewCaption = InputBox("Enter a caption for the form.")    
    'Set the new caption
    frmSimpleForm.Caption = sNewCaption    
    'Show another instance of the form
    MsgBox "OK - same form again except with default caption", vbOKOnly
    frmSimpleForm.Show
End Sub

 

20.3.3 Classy窗体

代码清单20.4:Classy窗体的代码

 

'代码清单20.4:Classy窗体的代码

Private Sub cmdOK_Click()
    Me.Hide
End Sub

 

代码清单20.5: Classy窗体范例

 

代码

'代码清单20.5: Classy窗体范例
Sub ClassyFormExample()
    Dim frm As frmClassy
    Dim vResponse As Variant
    
    'Instantiate frmClassy
    'This has the same effect as: Load frmClassy
    Set frm = New frmClassy
    
    'Prefill the edit box with a value(just for fun)
    frm.txtStuff = "Good Stuff"
    frm.Show
    
    'Form is now hidden, but you can still manipulate it
    vResponse = MsgBox("the classy form text box says: " & frm.txtStuff & ". View again ?", vbYesNo)
    
    If vResponse = vbYes Then
        'The form is still alive - show it
        'See - txtStuff has the same value as before
        frm.Show
    End If
    
    'RIP o Classy one
    Set frm = Nothing
End Sub

 

代码清单20.6: Classy窗体的多个实例

 

代码

'代码清单20.6: Classy窗体的多个实例

Sub ClassyFormExample2()
    Dim frm1 As frmClassy
    Dim frm2 As frmClassy
    
    Set frm1 = New frmClassy
    With frm1
        .Caption = "I am Classy"
        .Show
    End With
    
    Set frm2 = New frmClassy
    With frm2
        .Caption = "I am Classy too."
        .txtStuff = "I am Classy said '" & frm1.txtStuff & "'"
        .Show
    End With
    
    Set frm1 = Nothing
    Set frm2 = Nothing    
End Sub

 

 

20.4 窗体的生命周期

代码清单20.7: 跟踪窗体事件

 

代码

'代码清单20.7: 跟踪窗体事件

Dim mws As Worksheet
Dim msColor As String

Private Sub chkGridlines_Click()
    RecordEvent chkGridlines.Name, "Click"
    ActiveWindow.DisplayGridlines = chkGridlines.Value
    SetSummary
End Sub

Private Sub chkWeirdFont_Click()
    'It is possible that the font "Bradley Hand ITC"
    'may not be present on every PC
    On Error Resume Next
    
    RecordEvent chkWeirdFont.Name, "Click"
    
    If chkWeirdFont.Value Then
        mws.Cells.Font.Name = "Bradley Hand ITC"
    Else
        mws.Cells.Font.Name = "Arial"
    End If
    SetSummary
End Sub

Private Sub cmdHide_Click()
    RecordEvent cmdHide.Name, "Click"
    Me.Hide
    'Pause for brief period and
    'then reshow the form
    Application.Wait Now + 0.00003
    Me.Show
End Sub

Private Sub cmdOK_Click()
    RecordEvent cmdOK.Name, "Click"
    Unload Me
End Sub

Private Function RecordEvent(sControl As String, sEvent As String)
    Dim rg As Range
    
    Set rg = mws.Cells(65536, 1).End(xlUp).Offset(1, 0)
    rg.Value = sControl
    rg.Offset(0, 1).Value = sEvent
    Set rg = Nothing
End Function

Private Sub frmOptions_Click()
    RecordEvent frmOptions.Name, "Click"
End Sub

Private Sub optBlack_Change()
    RecordEvent optBlack.Name, "Change"
End Sub

Private Sub optBlack_Click()
    RecordEvent optBlack.Name, "Click"
    msColor = "Black"
    mws.Cells.Font.Color = vbBlack
    
    SetSummary
End Sub

Private Sub optBlue_Change()
    RecordEvent optBlue.Name, "Change"
End Sub

Private Sub optBlue_Click()
    RecordEvent optBlue.Name, "Click"
    msColor = "Blue"
    mws.Cells.Font.Color = vbBlue    
End Sub

Private Sub optGreen_Change()
    RecordEvent OptGreen.Name, "Change"

End Sub

Private Sub optGreen_Click()
    RecordEvent OptGreen.Name, "Click"
    msColor = "Green"
    mws.Cells.Font.Color = vbGreen    
End Sub

Private Sub txtName_AfterUpdate()
    RecordEvent txtName.Name, "AfterUpdate"
    mws.Name = txtName.Value
    SetSummary    
End Sub

Private Sub txtName_Change()
    On Error Resume Next
    RecordEvent txtName.Name, "Change"    
End Sub

Private Sub UserForm_Activate()
    RecordEvent Me.Name, "Activate"
    
End Sub

Private Sub UserForm_Deactivate()
    RecordEvent Me.Name, "Deactivate"    
End Sub

Private Sub UserForm_Initialize()
    On Error GoTo ErrHandler
    
    'Refer via worksheet code name
    'since this form can change the display name
    Set mws = wsEventTracing
    
    RecordEvent Me.Name, "initialize"
    
    'Activate the worksheet so you
    'can watch the events occur
    mws.Activate
    
    'Initialize controls on the form
    chkGridlines.Value = ActiveWindow.DisplayGridlines
    txtName.Text = mws.Name
    If mws.Cells.Font.Name <> "Bradley Hand ITC" Then
        chkWeirdFont.Value = False
    Else
        chkWeirdFont.Value = True
    End If
    InitializeBackgroundOptions
    SetSummary    
    Exit Sub
ErrHandler:
    Debug.Print "UserForm_Initialize: " & Err.Description
    Unload Me
End Sub

Private Sub InitializeBackgroundOptions()
    Select Case mws.Cells.Font.Color
        Case vbBlack
            optBlack.Value = True
            msColor = "Black"
        Case vbBlue
            optBlue.Value = True
            msColor = "Blue"
        Case vbGreen
            OptGreen.Value = True
            msColor = "Green"
        Case Else
            mws.Cells.Interior.Color = vbBlack
            optBlack.Value = True
    End Select
End Sub

Private Sub SetSummary()
    Dim sGridlines As String
    Dim sColor As String
    Dim sFont As String
    
    If chkWeirdFont.Value Then
        sFont = "weird"
    Else
        sFont = "Standard"
    End If
    
    lblSummary.Caption = mws.Name & " shows its data " & _
        sGridlines & " using a " & sFont & ", " & _
        msColor & " font "
End Sub

 

 

20.5 用户友好设置

代码清单20.8: 管理Settings窗体

 

代码

'代码清单20.8: 管理Settings窗体
Dim moSetting As setting
Dim moSettings As settings

Private Sub cboSetting_Change()
    'Get indicated setting and update
    'controls appropriately
    RefreshControls
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdEdit_Click()
    Dim sPassword As String
    
    If Not moSetting Is Nothing Then
        'for setReadProtectedWrite, you need to call
        'ChangeEditMode using the Password parameter
        If moSetting.settingtype = setReadProtectedWrite Then
            'have the user fill in their password
            frmPassword.Show
            sPassword = frmPassword.Password
            Unload frmPassword
            
            'make sure they entered a password
            If frmPassword.Tag = CStr(vbCancel) Then Exit Sub
            
            'try and change the edit mode
            If moSetting.changeeditmode(True, sPassword) Then
                txtValue.Enabled = True
            Else
                txtValue.Enabled = False
                MsgBox "invalid password", vbOKOnly
            End If
        Else
            'Don't need a password for unrestricted
            'read/write settings.
            moSetting.changeeditmode True
        End If
    End If    
End Sub

Private Sub cmdSave_Click()
    If Not moSetting Is Nothing Then
        moSetting.Value = txtValue.Text
        'turn off editing ablility
        moSetting.changeeditmode False
        cmdSave.Enabled = False
        txtValue.Enabled = False
    End If    
End Sub

Private Sub txtValue_Change()
    cmdSave.Enabled = True
End Sub

Private Sub UserForm_Initialize()
    Set moSettings = New settings
    cmdSave.Enabled = False
    
    'load cbosetting with settings
    LoadSettings
    
    'default to first setting in list
    If cboSetting.ListCount > 0 Then
        cboSetting.ListIndex = 0
    End If
End Sub

Private Sub LoadSettings()
    Dim lRow As Long
    Dim oSetting As setting
    Dim nSettingCount As Integer
    Dim nSetting As Integer
    
    nSettingCount = moSettings.Count
    
    'exit if there are not any settings
    If nSettingCount = 0 Then Exit Sub
    
    For nSetting = 1 To nSettingCount
        'Get setting
        Set oSetting = moSettings.Item(nSetting)
        
        'add all settings except private settings
        If oSetting.settingtype <> setprivate Then
            cboSetting.AddItem oSetting.Name
        End If
    Next
    
    Set oSetting = Nothing
End Sub

Private Sub RefreshControls()
    Dim sSetting As String
    Dim sValue As String
    Dim sComment As String
    
    Set moSetting = moSettings.Item(cboSetting.Value)
    If Not moSetting Is Nothing Then
    
        'disable edit ablility for read-only settings
        If moSetting.settingtype = setreadonly Then
            cmdEdit.Enabled = False
        Else
            'enable edit ablility for other settings
            cmdEdit.Enabled = True
        End If
        
        txtValue.Text = moSetting.Value
        txtDescription.Text = moSetting.Description
    End If
    
    txtValue.Enabled = False
    cmdSave.Enabled = False
End Sub

 

20.5.1 原始口令集

代码清单20.9: Password窗体使用的事件过程

 

代码

'代码清单20.9: Password窗体使用的事件过程
Dim msPassword As String

Public Property Get Password() As Variant
    Password = msPassword
End Property

Private Sub cmdCancel_Click()
    msPassword = CStr(vbCancel)
    'tag form to indicate how the form was dispatched
    Me.Tag = vbCancel
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    msPassword = txtPassword.Text
    'tag form to indicate how the form was dispatched
    Me.Tag = vbOK
    Me.Hide
End Sub

Private Sub UserForm_Initialize()
    txtPassword.SetFocus
End Sub

 

代码清单20.10: 从Password窗体中检索口令

 

代码

'代码清单20.10: 从Password窗体中检索口令

Sub DemonstratePassword()
    'Example 1: Retrieve password by inspecting txtPassword.value
    frmPassword.Show
    If frmPassword.Tag <> vbCancel Then
        MsgBox "you entered: " & frmPassword.txtPassword.Value, vbOKOnly
    Else
        MsgBox "you clicked cancel.", vbOKOnly
    End If
    
    'unload form from memory
    Unload frmPassword
    
    'Example 2: Retrieve password as a property of the form
    frmPassword.Show
    If frmPassword.Tag <> vbCancel Then
        MsgBox "you entered: " & frmPassword.Password, vbOKOnly
    Else
        MsgBox "you clicked cancel.", vbOKOnly
    End If
    
    'unload form from memory
    Unload frmPassword
End Sub

 

 

转载于:https://www.cnblogs.com/csl-office-vb-sql-net/archive/2010/01/21/1653257.html