链接用户窗体与工作表

前言

在使用Excel时，很多用户都希望有一个合适的数据输入窗体，在该窗体中输入数据后，这些数据会自动放置在工作表的相应单元格中，或者将工作表中的数据提取到窗体中便于直接查看。我整理了Dick有关这方面技术的一系列文章，在这里与大家分享。

演示——Excel的记录单

Excel提供了一个名为“记录单”的功能，用来让用户在窗体中输入数据并将数据放入工作表相应位置。如图1所示，单击“数据——记录单”，调出相应的对话框。（在Excel 2007中，单击“Office按钮——Excel选项”，在“Excel选项”对话框中选择“自定义——不在功能区中的命令（或所有命令）”，选择“记录单”并单击添加将其添加至快速访问工具栏）。

图1：Excel的“记录单”
此时，可以在对话框中输入相应的数据，单击“新建”按钮后，所输入的数据会放置到工作表中。然而，记录单有很大的局限，它限制用户能够做的事情并且不能完全定制。
注意，要调出“记录单”对话框，必须将活动单元格置于列表区域内。如果列表字段多于32个，将不能使用“数据——记录单”命令，用户必须直接在工作表中输入数据。
此外，John Walkenback还开发了一个优秀的记录单增强版本，有兴趣的朋友可以在网上找到该插件。这个增强版本的记录单能够满足绝大多数Excel用户的需要。

与工作表相链接的用户窗体

下面介绍的不是一个通用目的的数据记录单，而是为特定的数据库建立的数据录入窗体。其主要目的是为了说明用户可以使用用户窗体定制满足自身实际情况的输入和显示窗体。

• 用户窗体设计
  本示例的工作表如图1所示，包含人员的联系信息。本示例采用的用户窗体如图2所示，用来输入和编辑信息。该窗体共有6个标签控件，3个文本框控件，2个组合框控件，2个按钮控件，1个滚动条控件。其中滚动条控件用来导航记录。
  
  
  
  图2：数据输入窗体设计
  将上面的窗体命名为UContact，其中各控件的名称和Tag属性分别为：
  名称（Tag属性）
  txtName(0)
  cmbXb(1)
  txtAddress(2)
  txtCity(3)
  cmbState(4)
  txtZip(5)
  scbContact()
  cmdSave()
  cmdClose()
  lblName()
  lblXb()
  lblAddress()
  lblCity()
  lblState()
  lblZip()
  其中，Tag属性指出了工作表中数据相对于列A的偏移量。例如，txtName的Tag属性为0，表明在其中输入的数据就在A列。括号中为空表明该控件没有设置Tag属性。
• 装载用户窗体时
  下面的过程在用户窗体装载时，从工作表中读取数据并填充窗体中的相应控件。

   

  Private Sub PopulateRecord()    Dim lRow As Long    Dim ctlInfo As Control         '存储当前记录所在的行        lRow = Me.scbContact.Value         With wksContacts.Range("A1")    '遍历控件            For Each ctlInfo In Me.Controls    '如果Tag属性为数值，则该控件是数据输入控件                If IsNumeric(ctlInfo.Tag) Then    '从工作表中获取数据                    ctlInfo.Text = .Offset(lRow, ctlInfo.Tag).Value    End If    Next ctlInfo    End With         '标记清除的记录        Me.IsDirty = False    End Sub

  其中，wksContacts为工作表的对象名称。使用Tag属性存储每个字段相对于列A的偏移量，并且使用IsNumeric函数进行测试，以方便以后对窗体的扩展，例如当设置Tag属性为字符串型时。代码最后一行中的IsDirty属性将在随后的内容中讨论。

• 将用户窗体中的数据输入到工作表
  下面的过程与刚讲述的过程几乎相同，只是数据传输的方向相反，即将用户窗体中的数据输入到工作表相应的单元格中。

   

  Private Sub SaveRecord(Optional ByVal lOffset As Long = 0)    Dim lRow As Long    Dim ctlInfo As Control         '存储当前记录所在的行        lRow = Me.scbContact.Value + lOffset         With wksContacts.Range("A1")    '遍历控件            For Each ctlInfo In Me.Controls    '仅限于对数据输入控件                If IsNumeric(ctlInfo.Tag) Then    '将值写入单元格                    .Offset(lRow, ctlInfo.Tag).Value = ctlInfo.Text    End If    Next ctlInfo    End With         '重新初始化滚动条设置        DefineScroll         '标记清除的记录        Me.IsDirty = False    End Sub

  在代码中，初始化滚动条以便其值与工作表中的记录保持同步。

• 重定义滚动条
  

   

  Private Sub DefineScroll()    Dim rBottom As Range    Dim lRecordCnt As Long         With wksContacts    '查找列A中最后的单元格            Set rBottom = .Range("A" & .Rows.Count).End(xlUp)    '如果数据库为空            If rBottom.Row = 1 Then    lRecordCnt = 1 '设置一条记录-即新记录            Else    '设置所有的记录数再加一条新记录                lRecordCnt = .Range("A2", rBottom).Rows.Count + 1    End If    End With         '设置最小和最大值        Me.scbContact.Min = 1: Me.scbContact.Max = lRecordCnt    End Sub

  无论何时将数据写入工作表还是当用户窗体打开时从工作表中装载数据，我们都需要适当地设置滚动条的最小值和最大值。这样，确保从用户窗体中能够访问所有的记录，同时又能够使用用户窗体向工作表中添加新记录。

• 确认记录是否发生了变化
  当用户窗体显示记录时，需要知道用户是否修改了该记录，因为仅希望在记录发生改变时启用“保存”按钮。同时，在关闭没有保存的记录时，希望能够警告用户。
  这里使用了一个名为CControlEvents的类模块来完成这些任务。

   

  Public WithEvents gTextBox As MSForms.TextBox    Public WithEvents gCombo As MSForms.ComboBox    Private Sub gCombo_Change()    UContact.IsDirty = True    End Sub    Private Sub gTextBox_Change()    UContact.IsDirty = True    End Sub

  不能够处理通用的控件对象，因此必须为用户窗体中的每类控件（此处即文本框和组合框）创建一个变量。使用其Change事件来对记录作出标记。
  众所周知，用户窗体本身就是一个带有用户界面的内置类模块，这意味着能够从用户窗体中创建自定义属性。上面的事件代码使用了在用户窗体中创建的IsDirty属性。

  Private mbIsDirty As Boolean    Property Get IsDirty() As Boolean    IsDirty = mbIsDirty    End Property    Property Let IsDirty(bDirty As Boolean)    mbIsDirty = bDirty    Me.cmdSave.Enabled = bDirty    End Property

  Property Get过程允许读取IsDirty的值。Property Let过程在模块级变量中存储记录的状态，同时修改保存按钮的Enabled的属性。除非记录发生了变化，否则我们不希望用户启用保存按钮。

• 用户窗体的初始化事件
  下面，我们探讨用户窗体的初始化事件，例如当用户窗体开启时将会发生什么。首先，声明一个模块级的变量：

   

  Private mcControls As Collection

  然后，在用户窗体的Initialize事件代码中输入代码：

  Private Sub UserForm_Initialize()    Dim ctlInfo As Control    Dim clsEvents As CControlEvents         Set mcControls = New Collection         '使用隐藏的工作表中的数据填充组合框       'Xb和States为定义的单元格区域名称       Me.cmbXb.List = wksData.Range("Xb").Value    Me.cmbState.List = wksData.Range("States").Value         '遍历窗体中的控件        For Each ctlInfo In Me.Controls    'Tag属性为数值的控件是数据输入控件,是我们操作的控件            If IsNumeric(ctlInfo.Tag) Then    '创建新类                Set clsEvents = New CControlEvents    Select Case TypeName(ctlInfo)    Case "TextBox"    Set clsEvents.gTextBox = ctlInfo    mcControls.Add clsEvents, CStr(ctlInfo.Tag)    Case "ComboBox"    Set clsEvents.gCombo = ctlInfo    mcControls.Add clsEvents, CStr(ctlInfo.Tag)    End Select    End If    Next ctlInfo         DefineScroll         '以第一条记录开始        Me.scbContact.Value = Me.scbContact.Min    End Sub

  其中，wksData是存放组合框中所需要数据的工作表对象名称，分别为性别组合框存储的数据的名称为“Xb”，为“省份”组合框存储的数据的名称为“States”。
  上述代码遍历用户窗体中的数据输入控件并创建类的实例，以便触发事件且修改IsDirty属性，同时设置滚动条的初始值。
  注意，此时会触发PopulateRecord过程执行两次，即执行DefineScroll过程时和为滚动条设置值时，都会触发滚动条的Change事件。

• 滚动条的Change事件
  滚动条能够帮助用户在记录之间移动。当然，不一定需要滚动条。
  首先，声明一个模块级的变量：

   

  Private mlLastScrollValue As Long

  然后，在滚动条scbContact的Change事件中输入代码：

  Private Sub scbContact_Change()    Dim sPrompt As String    Dim sTitle As String    Dim lResp As Long         sPrompt = "保存修改"    sTitle = "记录已经改变"         If Me.IsDirty Then    lResp = MsgBox(sPrompt, vbYesNo, sTitle)    If lResp = vbYes Then    SaveRecord CLng(Me.scbContact.Value > mlLastScrollValue)    End If    End If         PopulateRecord         mlLastScrollValue = Me.scbContact.Value    End Sub

  上述过程检查是否需要保存当前记录并给出提示信息，然后基于滚动条的当前值填充记录。模块级的变量mlLastScrollValue包含滚动条先前的值，以便SaveRecord过程确定是否用户向上或向下滚动过。通常，必须知道是否保存前一条或后一条记录，因为滚动条的值已经变化。

• 命令按钮的Click事件
  “关闭”按钮：

   

  Private Sub cmdClose_Click()    Unload Me    End Sub

  “保存”按钮：

  Private Sub cmdSave_Click()    If Me.IsDirty Then    SaveRecord    End If    End Sub

• 最后的成果
  下图3是最终的用户窗体运行后的效果：
  
  
  
  图3：自定义的用户输入窗体
  拖动右侧的滚动条可以在记录之间移动，当拖动到最下方时，可以新建记录。

示例文档下载：

功能扩展

现在，让我们为该用户窗体增加新功能，即在原有功能的基础上增加搜索功能。当在用户窗体的查找部分选择字段并输入相应的数据后，能搜索到记录并在用户窗体中显示相关数据，如图4所示。

图4：在用户窗体中增加搜索功能
在原用户窗体中添加一个框架，在框架内添加组合框、文本框和命令按钮，各控件的名称和Tag属性如下：
名称（Tag属性）
frmFind()
cmbFind()
txtFind()
cmdFind(tgFind)
其中，括号内为空表明没有设置该控件的Tag属性。
为了使用户能搜索任一字段，因此添加了组合框cmbFind。用户可以首先从中选择要搜索的字段，然后在右侧的文本框中输入要搜索数据的全部或部分内容，最后当单击查找按钮后在下方显示该条记录的详细信息。
要填充组合框，在用户窗体的初始化事件Initialize的代码中添加下列语句：

Me.cmbFind.List = Application.Transpose(wksContacts.Range("ColHeads").Value)

其中，ColHeads为工作表中标题行区域的名称。此时，在将该名称区域的数据放置到组合框之前，需要将列数据转置为行数据。
接下来，确保查找按钮处于禁用状态，直到在组合框和文本框中含有相应的数据。因此，添加了两个事件过程和一个启用/禁用按钮控件的过程。代码如下：

Private Sub cmbFind_Change()'如果用户已选择组合框中的项目或者在文本框中输入内容    '那么启用查找按钮    If Me.cmbFind.ListIndex > -1 And Len(Me.txtFind.Text) > 0 ThenEnableControls "tgFind"ElseEnableControls "tgFind", TrueEnd IfEnd Sub Private Sub txtFind_Change()If Me.cmbFind.ListIndex > -1 And Len(Me.txtFind.Text) > 0 ThenEnableControls "tgFind"ElseEnableControls "tgFind", TrueEnd IfEnd Sub Private Sub EnableControls(sTag As String, _Optional bDisable As Boolean = False)Dim ctl As ControlFor Each ctl In Me.ControlsIf ctl.Tag = sTag Thenctl.Enabled = Not bDisableEnd IfNext ctlEnd Sub

查找按钮cmdFind的代码如下：

Private Sub cmdFind_Click()Dim lCol As LongDim rFound As Range '因为组合框的ListIndex属性起始值为0,因此加1以确定搜索列    lCol = Me.cmbFind.ListIndex + 1 '查找包含文本框中文本的第一个单元格    'Lookat参数的值为xlPart表明不需要完全匹配    Set rFound = wksContacts.Columns(lCol).Find(What:=Me.txtFind.Text, _LookIn:=xlValues, _LookAt:=xlPart) '如果找到记录则改变滚动条到该记录    '否则显示一条新记录    If Not rFound Is Nothing ThenMe.scbContact.Value = rFound.Row - 1ElseMe.scbContact.Value = Me.scbContact.MaxEnd IfEnd Sub

至此，新增功能完成。当然，您可以按需要再添加其他功能，以丰富该用户窗体。或者根据本文的思路，重新设计用户窗体，以满足您的实际需要。
示例文档下载：

答疑解惑

在准备发表本文时，接到一位朋友的求助邮件，提出的几个问题正好可以使用本文的示例（稍作修改）来解决。

• 问题1：比如在一个合同台帐中，点击某一记录合同编号的单元格后，与该合同相关的所有信息将显示在一个无模式的窗体中，并实现实时跟踪
• 问题2：在Sheet1中生成了一个无模式的窗体（其ShowModal = False），该窗体中的文本框TextBox1能否实时跟踪该工作表中ActiveCell的内容？比如说用鼠标点击该工作表中的A1单元格，窗体中TextBox1便显示A1单元格中的值；点击B1，文本框便会显示B1的值？如何实现？

在上述示例中修改并增加一些代码：
将PopulateRecord过程由Private修改为Public：

Public Sub PopulateRecord()

将用户窗体的初始化事件Initialize过程的最后一行修改为：

    If ActiveCell.Row <= rBottom.Row ThenMe.scbContact.Value = ActiveCell.Row - 1Else'以第一条记录开始        Me.scbContact.Value = Me.scbContact.MinEnd If

在工作表wksContacts中增加事件代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim rBottom As Range With wksContacts'查找列A中最后的单元格        Set rBottom = .Range("A" & .Rows.Count).End(xlUp)End With '卸载原窗体    If lRow <> Target.Row ThenUnload UContactEnd If '活动单元格在第1列中,且该列中有数据时才显示窗体    If Target.Column = 1 And Target.Row > 1 And Target.Row <= rBottom.Row ThenUContact.Show 0 '无模式窗体    End If '填充窗体,使得工作表中单元格值发生改变后能实时反映到窗体中    UContact.PopulateRecord'只要显示均启用窗体中的保存按钮,根据需要这句可删除    UContact.cmdSave.Enabled = True '该变量用于更新窗体显示    '即活动单元格变化后,显示该单元格所在行的内容    lRow = Target.Row End Sub

此时，当您单击工作表Sheet1中第1列有数据的单元格时，就会出现显示活动单元格所在行详细信息的用户窗体，可以在该行中修改数据，数据会实时反映到用户窗体中，当活动单元格离开该行后，如果活动单元格仍在第1列且该列有数据，则用户窗体仍显示该行详细信息，否则用户窗体消失。

• 问题3：TextBox中能否使用公式？比如 =IF($B3<>“”,IF(ISNA(VLOOKUP($B3,Database_2,3,0)),”",VLOOKUP($B3,Database_2,3,0)),”")实现查询功能？

上述示例中的查找部分使用的文本框就实现了查询功能。
示例文档下载：