第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