完美Excel

本文是《链接用户窗体与工作表》一文的续篇，在阅读本文之前，请先阅读《链接用户窗体与工作表》。
现在，我们需要使该用户窗体在原有功能的基础上增加搜索功能。当选择字段并输入相应的数据后，能搜索到记录并显示在用户窗体中，如图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 Then
EnableControls “tgFind”
Else
EnableControls “tgFind”, True
End If
End Sub

Private Sub txtFind_Change()
If Me.cmbFind.ListIndex > -1 And Len(Me.txtFind.Text) > 0 Then
EnableControls “tgFind”
Else
EnableControls “tgFind”, True
End If
End Sub

Private Sub EnableControls(sTag As String, _
Optional bDisable As Boolean = False)
Dim ctl As Control
For Each ctl In Me.Controls
If ctl.Tag = sTag Then
ctl.Enabled = Not bDisable
End If
Next ctl
End Sub

查找按钮cmdFind的代码如下：

Private Sub cmdFind_Click()
Dim lCol As Long
Dim rFound As Range

‘如果找到记录则改变滚动条到该记录
‘否则显示一条新记录
If Not rFound Is Nothing Then
Me.scbContact.Value = rFound.Row - 1
Else
Me.scbContact.Value = Me.scbContact.Max
End If
End Sub

至此，新增功能完成。当然，您可以按需要再添加其他功能，以丰富该窗体。

前言：在使用Excel时，很多用户都希望有一个合适的数据输入窗体，在该窗体中输入数据后，这些数据会自动放置在工作表的相应单元格中，或者将工作表中的数据提取到窗体中。这里，我找到了Dick的一系列文章并将它们进行了整理，与大家分享。
演示——Excel的记录单
Excel提供了一个名为“记录单”的功能，用来让用户在窗体中输入数据并将数据放入工作表相应位置。如图1所示，单击“数据——记录单”，调出相应的对话框。

图1：Excel的“记录单”
此时，可以在对话框中输入相应的数据，单击“新建”按钮后，所输入的数据会放置到工作表中。然而，记录单有很大的局限，它限制用户能够做的事情并且不能完全定制。
（注意，要调出“记录单”对话框，必须将活动单元格置于列表区域内。如果列表字段多于32个，将不能使用“数据——记录单”命令，用户必须直接在工作表中输入数据。
此外，John Walkenback还开发了一个优秀的记录单增强版本，有兴趣的朋友可以在网上找到该插件。这个增强版本的记录单能够满足绝大多数Excel用户的需要。）
下面介绍的不是一个通用目的的数据记录单，而是为特定的数据库建立的数据录入窗体。其主要目的是为了说明，用户可以使用用户窗体定制满足自身实际情况的输入窗体。
创建用户窗体
本示例的工作表如图1所示，包含着人员的联系信息。本示例的用户窗体如图2所示，用来输入和编辑信息。

图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

‘使用隐藏的工作表中的数据填充组合框
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：自定义的用户输入窗体
拖动右侧的滚动条可以在记录之间移动，当拖动到最下方时，可以新建记录。
实例扩展
当然，您可以以上面的示例为基础，修改或扩展窗体，根据实际需要增强其应用功能。

本文示例工作簿下载请单击：链接工作表与用户窗体

首先看看下图：

这是一个用户窗体，看不出来吧，但确实是一个用户窗体。我们使用代码去除了它的最大化、最小化和关闭按钮并作了一些设置，使得它好像是一个浮动工具栏。下面程序中的SetUserformAppearance过程用于设置用户窗体的样式，可作为通用的程序调用。该过程能够独立设置：

• 窗体是否有标题栏
• 用作浮动工具栏时，标题栏是否为常规尺寸或小尺寸
• 是否可以改变窗体大小
• 窗体是否有最大化按钮
• 窗体是否有最小化按钮
• 窗体是否有关闭按钮
• 窗体是否有图标以及图标是否可用

（也可参考《Professional Excel Development》中的第10章）

在VBE中插入一个用户窗体，如上图所示，在其中放置一个标签并输入文本、放置一个按钮。

然后，插入一个标准模块，在其中输入下面的代码：

   1: ' 说明: 修改用户窗体的窗口样式

   2: Option Explicit

   3:  

   4: ' Windows API声明和常量声明

   5: Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

   6: Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

   7: Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

   8: Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

   9: Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

  10:  

  11: Private Const GWL_STYLE As Long = (-16)           '窗口样式偏移量

  12: Private Const GWL_EXSTYLE As Long = (-20)         '窗口扩展样式偏移量

  13: Private Const WS_CAPTION As Long = &HC00000       '添加标题栏

  14: Private Const WS_SYSMENU As Long = &H80000        '添加系统菜单

  15: Private Const WS_THICKFRAME As Long = &H40000     '添加可调整的框架

  16: Private Const WS_MINIMIZEBOX As Long = &H20000    '在标题栏中添加最小化框

  17: Private Const WS_MAXIMIZEBOX As Long = &H10000    '在标题栏中添加最大化框

  18: Private Const WS_EX_DLGMODALFRAME As Long = &H1   '控制是否窗口有图标

  19: Private Const WS_EX_TOOLWINDOW As Long = &H80     '工具窗口:最小标题栏

  20: Private Const SC_CLOSE As Long = &HF060           '关闭菜单项

  21:  

  22: '用户窗体样式枚举列表

  23: Public Enum UserformWindowStyles

  24:     uwsNoTitleBar = 0

  25:     uwsHasTitleBar = 1

  26:     uwsHasSmallTitleBar = 2

  27:     uwsHasMaxButton = 4

  28:     uwsHasMinButton = 8

  29:     uwsHasCloseButton = 16

  30:     uwsHasIcon = 32

  31:     uwsCanResize = 64

  32:     uwsDefault = uwsHasTitleBar Or uwsHasCloseButton

  33: End Enum

  34:  

  35: ' 说明: 设置用户窗体的窗口样式的程序

  36: '

  37: ' 参数:    frmForm    要改变样式的用户窗体

  38: '          lStyles    设置样式的枚举值,能够将枚举值添加在一起以设置多个样式

  39: '          sIconPath  如果设置uwsHasIcon样式,那么这是用于窗体的图标文件的路径

  40: '

  41: Sub SetUserformAppearance(ByRef frmForm As Object, ByVal lStyles As UserformWindowStyles, Optional ByVal sIconPath As String)

  42:  

  43:     Dim sCaption As String

  44:     Dim hwnd As Long

  45:     Dim lStyle As Long

  46:     Dim hMenu As Long

  47:  

  48:     '查找窗体的窗口句柄

  49:     sCaption = frmForm.Caption

  50:     frmForm.Caption = "FindThis" & Rnd

  51:     hwnd = FindOurWindow("ThunderDFrame", frmForm.Caption)

  52:     frmForm.Caption = sCaption

  53:  

  54:     '如果要小的标题栏,不要图标,也不要最大化或最小化按钮

  55:     If lStyles And uwsHasSmallTitleBar Then

  56:         lStyles = lStyles And Not (uwsHasMaxButton Or uwsHasMinButton Or uwsHasIcon)

  57:     End If

  58:  

  59:     '获取正常的窗口样式位

  60:     lStyle = GetWindowLong(hwnd, GWL_STYLE)

  61:  

  62:     '适当地更新正常的样式位

  63:     '如果要图标或者最大化、最小化或关闭按钮,则必须有系统菜单

  64:     ModifyStyles lStyle, lStyles, uwsHasIcon Or uwsHasMaxButton Or uwsHasMinButton Or uwsHasCloseButton, WS_SYSMENU

  65:  

  66:     '大多数情况下需要标题栏!

  67:     ModifyStyles lStyle, lStyles, uwsHasIcon Or uwsHasMaxButton Or uwsHasMinButton Or uwsHasCloseButton Or uwsHasTitleBar Or uwsHasSmallTitleBar, WS_CAPTION

  68:  

  69:     ModifyStyles lStyle, lStyles, uwsHasMaxButton, WS_MAXIMIZEBOX

  70:     ModifyStyles lStyle, lStyles, uwsHasMinButton, WS_MINIMIZEBOX

  71:     ModifyStyles lStyle, lStyles, uwsCanResize, WS_THICKFRAME

  72:  

  73:     '使用正常样式位更新窗口

  74:     SetWindowLong hwnd, GWL_STYLE, lStyle

  75:  

  76:     '获取扩展的样式位

  77:     lStyle = GetWindowLong(hwnd, GWL_EXSTYLE)

  78:  

  79:     '适当地修改

  80:     ModifyStyles lStyle, lStyles, uwsHasSmallTitleBar, WS_EX_TOOLWINDOW

  81:  

  82:     If lStyles And uwsHasIcon Then

  83:         lStyle = lStyle And Not WS_EX_DLGMODALFRAME

  84:         

  85:         '设置图标,如果有

  86:         SetIcon hwnd, sIconPath

  87:     Else

  88:         lStyle = lStyle Or WS_EX_DLGMODALFRAME

  89:         

  90:         '设置图标,如果有

  91:         SetIcon hwnd, ""

  92:     End If

  93:  

  94:     '使用扩展样式位更新窗口

  95:     SetWindowLong hwnd, GWL_EXSTYLE, lStyle

  96:  

  97:     '通过从控制菜单移除处理关闭按钮而不是通过窗口样式位

  98:     If lStyles And uwsHasCloseButton Then

  99:         '需要则重置控制菜单

 100:         hMenu = GetSystemMenu(hwnd, 1)

 101:     Else

 102:         '不需要则将其从控制菜单中删除

 103:         hMenu = GetSystemMenu(hwnd, 0)

 104:         DeleteMenu hMenu, SC_CLOSE, 0&

 105:     End If

 106:  

 107:     '刷新变化后的窗口

 108:     DrawMenuBar hwnd

 109:  

 110: End Sub

 111:  

 112: ' 说明: 检查是否样式位被设置和设置/清除了相应的窗口样式位

 113: '

 114: Private Sub ModifyStyles(ByRef lFormStyle As Long, ByVal lStyleSet As Long, ByVal lChoice As UserformWindowStyles, ByVal lWS_Style As Long)

 115:  

 116:     If lStyleSet And lChoice Then

 117:         lFormStyle = lFormStyle Or lWS_Style

 118:     Else

 119:         lFormStyle = lFormStyle And Not lWS_Style

 120:     End If

 121:  

 122: End Sub

再插入一个标准模块，并输入下面的代码：

   1: Option Explicit

   2: Option Private Module

   3:  

   4: ' 为ApphWnd和FindOurWindow示例函数的声明

   5: ' 获取桌面窗口的句柄

   6: Private Declare Function GetDesktopWindow Lib "user32" () As Long

   7:  

   8: '查找具有指定类名和标题的子窗口

   9: Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

  10:  

  11: '获取当前Excel实例的ID

  12: Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

  13:  

  14: '获取正处理的窗口的ID

  15: Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long

  16:  

  17: ' 为WorkbookWindowhWnd示例函数的声明

  18: ' WorkbookWindowhWnd过程使用上面定义的FindWindowEx

  19: ' 为SetNameDropdownWidth示例函数的声明

  20: ' 在SendMessage调用中使用的常量

  21:  

  22: Private Const CB_SETDROPPEDWIDTH As Long = &H160&     'winuser.h

  23:  

  24: ' 函数声明

  25: ' SetNameDropdownWidth过程也使用上面定义的FindWindowEx

  26: ' 发送给窗口的消息

  27: Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

  28:  

  29: ' 为SetIcon示例过程的声明

  30: ' 用于SendMessage调用的常量

  31: Private Const WM_SETICON As Long = &H80

  32:  

  33: ' 函数声明

  34: ' SetIcon过程也使用上面定义的SendMessage

  35: ' 获取文件图标的句柄

  36: Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

  37:  

  38: ' 查找Excel主窗口句柄

  39: Function ApphWnd() As Long

  40:  

  41:     If Val(Application.Version) >= 10 Then

  42:         ApphWnd = Application.hwnd

  43:     Else

  44:         ApphWnd = FindOurWindow("XLMAIN", Application.Caption)

  45:     End If

  46:  

  47: End Function