2010年01月19日, 7:07 下午

Loading ...
有时,需要选中某列表框的的项目后,在另一列表框中显示该项目的具体内容,如下图1所示。

图1:两个列表框实现内容匹配
“专业工程”包括“建筑工程、装饰装修工程……”等,当选中项目列表框中的专业工程后,在分类列表框中显示相应的内容。同理,选择项目列表框中的措施项目后,在分类列表框中也会显示相应的内容。
第一步:准备数据
如下图2所示,在工作表Sheet1中输入下列数据。

图2:基础数据
将A列的数据命名为“项目”,将B列的数据命名为“专业工程”,将C列的数据命名为“措施项目”。注意,B列和C列的名称应与A列的数据相一致。
第二步:准备窗体界面
如图1所示,在用户窗体中放置两个标签控件、两个列表框控件,并将两个列表框控件分别命名为lbxItem和lbxCategory。
第三步:输入代码
在用户窗体代码模块中,输入下列代码:
Private Sub lbxItem_Change()
Dim rngCategory As Range
Set rngCategory = Sheet1.Range(Me.lbxItem.Value)
Me.lbxCategory.List = rngCategory.Value
End Sub
Private Sub UserForm_Initialize()
Dim rngItem As Range
Set rngItem = Sheet1.Range("项目")
Me.lbxItem.List = rngItem.Value
End Sub
运行后的最终效果如图1所示。当然,您可以在A列添加更多的项目数据,然后在C列、D列……添加相应的内容并以A列的数据命名,从而扩展本实例。
(注:网站空间被删前的文章,有一定的学习意义,故找出来重新贴出之)
2009年09月29日, 2:24 下午

Loading ...
这是在EH中看到的一个贴子《求高手作一个数据输入窗口》,其要求为:
这个表是用来输入公司的采购数据的,为了输入的规范,便于把采购单价用公式导入计算销售的表格中,所以必须采用输菜编码的方式录入,但是菜编码太多,很难记住,特别是对于新员工,所以设计了简码,想实现动画图片那样的功能,请高手帮忙!!!
1、如果记得住菜号,在菜号单元格中输入菜号,在输的过程中能逐步提示,如附图动画。
2、如果记不住菜号,就在菜号单元格中输入简码,输入简码过程中能逐步提示,简码会有重复的菜名,按上下箭头能进行选择,输完回车后,显示的还是菜号,而不是简码,如附图动画。
3、如果能做成一个类似EXCEL中的记录单(如图:输单界面)的形式更好。
初步做了一下,实现的效果如下:
“采购录入信息”工作表:选择列A中的任意单元格或者双击列A中的任意单元格将弹出下图所示的输入对话框。

在上方的文本框中输入菜号或者简码后,下方的列表框将自动搜索匹配的数据。
单击下方列表框中的数据后,相关数据将自动输入到“采购录入信息”工作表的列A和列B中,同时其它列的信息自动填充。
主要的程序代码如下:
Option Explicit
Dim varData, lOldLen
Private Sub UserForm_Initialize()
Dim lLast As Long
Dim rng As Range
lLast = wksCP.Range("A" & Cells.Rows.Count).End(xlUp).Row
varData = wksCP.Range("A2:C" & lLast)
With Me.lbxInfo
.BoundColumn = 1
.ColumnCount = 3
.List = varData
End With
End Sub
Private Sub txtFind_Change()
Dim i As Long
Dim strFind As String
strFind = "*" & UCase(Me.txtFind.Text) & "*"
With Me.lbxInfo
If Len(Me.txtFind.Text) < lOldLen Then
.List = varData
End If
lOldLen = Len(Me.txtFind.Text)
For i = .ListCount - 1 To 0 Step -1
If (Not UCase(.List(i, 0)) Like strFind) And (Not UCase(.List(i, 2)) Like strFind) Then
.RemoveItem i
End If
Next i
End With
End Sub
Private Sub lbxInfo_Click()
Dim lListIndex As Long
lListIndex = Me.lbxInfo.ListIndex
ActiveCell.Value = Me.lbxInfo.List(lListIndex, 0)
ActiveCell.Offset(0, 1).Value = Me.lbxInfo.List(lListIndex, 2)
Unload frmEnterInfo
End Sub
Private Sub btnClose_Click()
Unload frmEnterInfo
End Sub
示例下载:
操作演示:
2009年05月12日, 1:41 下午

Loading ...
在使用Google搜索时,一般我们会在输入框中输入想要搜索的文本,此时下方会出现相关条目供选择,以方便快速输入。下面,我们在Excel用户窗体中使用文本框和列表框来仿造这样的效果。
有时,当用户窗体中的列表框包含大量的项目时,我们必须拖动其滚动条来查找相应的项目。此时,可以利用一些技巧快速找到所需的项目。
如图1所示,在用户窗体中,放置有两个控件,上方是一个名为txtFind的文本框,下方是一个名为lbxData的列表框,列表框的数据来自工作表Data的列A中的数据。

图1:带有文本框和列表框的用户窗体,列表框中的数据来自Data工作表中的A列
当我在上方的文本框txtFind中输入“excel vba”后,下方的列表框lbxData中将会只出现包含有“excel vba”的条目,如图2所示。

图2:在文本框中输入文本后,列表框中只出现包含该文本的条目
实现上述效果的VBA代码如下:
Option Explicit
Dim varData
Private Sub txtFind_Change()
Dim i As Long
Dim strFind As String
strFind = "*" & UCase(Me.txtFind.Text) & "*"
With Me.lbxData
.List = varData
For i = .ListCount - 1 To 0 Step -1
If Not UCase(.List(i)) Like strFind Then
.RemoveItem i
End If
Next i
End With
End Sub
Private Sub UserForm_Initialize()
Dim lLast As Long
Dim rng As Range
lLast = Sheet1.Range("A" & Cells.Rows.Count).End(xlUp).Row
varData = Sheet1.Range("A1:A" & lLast)
Me.lbxData.List = varData
End Sub
我们可以将UserForm_Initialize代码块中的代码Me.lbxData.List = varData删除,这样当在文本框txtFind中输入时,只要输入的数据符合列表框包含的数据,列表框中将自动出现相关条目并随着输入的进一步具体条目相应减少至完全匹配输入的数据,如图3、4、5所示。

图3:初始化后的用户窗体

图4:开始输入后,列表框中的条目随着文本框中输入的数据而变化

图5:文本框中的数据越具体,列表框中的条目也越少且与文本框输入相匹配
在Excel 2000及以后的版本中,VBA提供了一个Filter函数,使用该函数,也能实现上述效果,并且代码更简单。代码如下:
Option Explicit
Private Sub txtFind_Change()
Dim varData As Variant
varData = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
varData = Application.Transpose(varData)
varData = Filter(SourceArray:=varData, _
Match:=txtFind.Value, _
Include:=True, _
Compare:=vbTextCompare)
Me.lbxData.List = varData
End Sub
Private Sub UserForm_Initialize()
Me.lbxData.List = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
End Sub
如果需要将列表框中所选择的条目放到文本框中,那么添加下面的代码:
Private Sub lbxData_Click()
Me.txtFind.Value = Me.lbxData.Value
End Sub
示例文档下载:
在使用Google搜索时,一般我们会在输入框中输入想要搜索的文本,此时下方会出现相关条目供选择,以方便快速输入。下面,我们在Excel用户窗体中使用文本框和列表框来仿造这样的效果。
有时,当用户窗体中的列表框包含大量的项目时,我们必须拖动其滚动条来查找相应的项目。此时,可以利用一些技巧快速找到所需的项目。
如图1所示,在用户窗体中,放置有两个控件,上方是一个名为txtFind的文本框,下方是一个名为lbxData的列表框,列表框的数据来自工作表Data的列A中的数据。

图1:带有文本框和列表框的用户窗体,列表框中的数据来自Data工作表中的A列
当我在上方的文本框txtFind中输入“excel vba”后,下方的列表框lbxData中将会只出现包含有“excel vba”的条目,如图2所示。

图2:在文本框中输入文本后,列表框中只出现包含该文本的条目
实现上述效果的VBA代码如下:
Option Explicit
Dim varData
Private Sub txtFind_Change()
Dim i As Long
Dim strFind As String
strFind = "*" & UCase(Me.txtFind.Text) & "*"
With Me.lbxData
.List = varData
For i = .ListCount - 1 To 0 Step -1
If Not UCase(.List(i)) Like strFind Then
.RemoveItem i
End If
Next i
End With
End Sub
Private Sub UserForm_Initialize()
Dim lLast As Long
Dim rng As Range
lLast = Sheet1.Range("A" & Cells.Rows.Count).End(xlUp).Row
varData = Sheet1.Range("A1:A" & lLast)
Me.lbxData.List = varData
End Sub
我们可以将UserForm_Initialize代码块中的代码Me.lbxData.List = varData删除,这样当在文本框txtFind中输入时,只要输入的数据符合列表框包含的数据,列表框中将自动出现相关条目并随着输入的进一步具体条目相应减少至完全匹配输入的数据,如图3、4、5所示。

图3:初始化后的用户窗体

图4:开始输入后,列表框中的条目随着文本框中输入的数据而变化

图5:文本框中的数据越具体,列表框中的条目也越少且与文本框输入相匹配
在Excel 2000及以后的版本中,VBA提供了一个Filter函数,使用该函数,也能实现上述效果,并且代码更简单。代码如下:
Option Explicit
Private Sub txtFind_Change()
Dim varData As Variant
varData = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
varData = Application.Transpose(varData)
varData = Filter(SourceArray:=varData, _
Match:=txtFind.Value, _
Include:=True, _
Compare:=vbTextCompare)
Me.lbxData.List = varData
End Sub
Private Sub UserForm_Initialize()
Me.lbxData.List = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
End Sub
如果需要将列表框中所选择的条目放到文本框中,那么添加下面的代码:
Private Sub lbxData_Click()
Me.txtFind.Value = Me.lbxData.Value
End Sub
示例文档下载:
2009年03月16日, 2:23 下午

Loading ...
通常,我们可以在选择要复制的文本后,按Ctrl+C组合键来复制文本。下面通过两个简单的示例介绍如何使用VBA代码复制用户窗体文本框中的文本数据。
示例一:如下图1所示,在示例窗体中有一个文本框和一个命令按钮。当窗体被激活时,文本框中自动显示文字“完美Excel”,单击“复制文本”按钮后,将文本框中的数据复制到剪贴板。

图1:带有文本框和命令按钮的用户窗体
首先,按图1设计好用户窗体界面。然后,在该用户窗体模块中,输入下列代码:
Dim myClipboard As New DataObject
Private Sub UserForm_Activate()
Me.TextBox1.Value = "完美Excel"
End Sub
Private Sub CommandButton1_Click()
With myClipboard
.SetText Me.TextBox1.Text
.PutInClipboard
End With
End Sub
示例二:在用户窗体中有多个文本框,要求单击按钮后将含有数据的文本框中的数据全部复制到剪贴板。用户窗体如下图2所示,含有6个文本框。

图2:带有多个文本框的用户窗体
首先,按图2设计好用户窗体界面。然后,在用户窗体模块中,输入下列代码:
Dim strUnion As String
Private Sub CommandButton1_Click()
Dim dObj As DataObject
With Me
If Not .TextBox1 = Empty Then strUnion = strUnion & .TextBox1
If Not .TextBox2 = Empty Then strUnion = strUnion & vbCrLf & .TextBox2
If Not .TextBox3 = Empty Then strUnion = strUnion & vbCrLf & .TextBox3
If Not .TextBox4 = Empty Then strUnion = strUnion & vbCrLf & .TextBox4
If Not .TextBox5 = Empty Then strUnion = strUnion & vbCrLf & .TextBox5
If Not .TextBox6 = Empty Then strUnion = strUnion & vbCrLf & .TextBox6
End With
Set dObj = New DataObject
dObj.SetText strUnion, 1
dObj.PutInClipboard
End Sub
说明与扩展
下面对示例中涉及到的主要对象及其属性、方法进行简单的介绍和整理,并进行一些扩展(也可参考VBA帮助)。
本文虽然题为复制文框框中的数据,但DataObject对象也可应用到其他的用户窗体控件中。
- DataObject 对象
DataObject对象能够像“剪贴板”一样保存一段文本格式的文本,并能为每种附加的文本格式(例如用户定义的格式)保存一段文本。
DataObject对象的工作方式与“剪贴板”很相像。如果将一串文本复制到DataObject对象,DataObject 对象将保存该文本。如果将相同格式的第二段文本复制到该DataObject对象,则DataObject对象将清除前一文本,并保存第二段的文本。对于每种指定的格式,它保存一段从最近一次操作得到的文本。
但DataObject对象又与“剪贴板”不同,DataObject支持与“剪贴板”及文本的拖放操作有关的命令。在开始进行与“剪贴板”有关的操作(如GetText)或拖放操作时,与该操作有关的数据会被移到DataObject对象中。
DataObject对象具有下列方法:
- SetText方法:使用特定的格式复制文本串到DataObject对象中。
- GetText方法:使用特定的格式在DataObject对象中检索文本串。
- GetFormat方法:返回的值表示DataObject对象中是否有指定的格式。
- StartDrag方法:初始化针对DataObject的拖放操作。
- GetFromClipboard:从剪贴板复制数据到DataObject对象。
- PutInClipboard:将数据从DataObject对象移到剪贴板上。
- Clear方法:删除DataObject对象中的所有对象。
- GetFormat方法、GetText方法 和SetText方法示例
本示例使用GetFormat方法、GetText方法和SetText方法在DataObject对象和剪贴板之间传输文本。
示例窗体如下图3所示,带有一个文本框TextBox1,四个命令按钮CommandButton1、CommandButton2、CommandButton3和CommandButton,以及一个标签Label1。用户把文本键入文本框然后单击命令按钮CommandButton1,把文本以标准文本格式传输到DataObject对象。单击命令按钮CommandButton2,在DataObject对象中检索文本。单击命令按钮CommandButton3,用自定义格式把文本从文本框TextBox1复制到DataObject对象。单击命令按钮CommandButton4,用自定义格式在DataObject对象中检索文本。

图3:演示GetFormat、GetText、SetText方法的用户窗体
窗体模块中的代码为:
Dim MyDataObject As DataObject
Private Sub CommandButton1_Click()
'把标准格式放到剪贴板上
If TextBox1.TextLength > 0 Then
Set MyDataObject = New DataObject
MyDataObject.SetText TextBox1.Text
Label1.Caption = "放置到DataObject中"
CommandButton2.Enabled = True
CommandButton4.Enabled = False
End If
End Sub
Private Sub CommandButton2_Click()
'从剪切板得到标准格式
If MyDataObject.GetFormat(1) = True Then
Label1.Caption = "标准格式 - " _
& MyDataObject.GetText(1)
End If
End Sub
Private Sub CommandButton3_Click()
'把自定义格式放到剪切板上
If TextBox1.TextLength > 0 Then
Set MyDataObject = New DataObject
MyDataObject.SetText TextBox1.Text, 233
Label1.Caption = "在DataObject中的自定义格式"
CommandButton4.Enabled = True
CommandButton2.Enabled = False
End If
End Sub
Private Sub CommandButton4_Click()
'从剪切板得到自定义格式
If MyDataObject.GetFormat(233) = True Then
Label1.Caption = "自定义格式 - " _
& MyDataObject.GetText(233)
End If
End Sub
Private Sub UserForm_Initialize()
CommandButton2.Enabled = False
CommandButton4.Enabled = False
End Sub
- Copy方法、GetFromClipboard方法、GetText方法和DataObject对象示例
本示例演示从文本框到剪贴板,从剪贴板到DataObject对象以及从DataObject对象到另一个文本框的数据移动。GetFromClipboard方法把数据从剪贴板传输到DataObject对象。该示例还使用了Copy方法和GetText方法。
示例窗体如下图4所示,带有两个文本框和一个命令按钮。单击命令按钮,将把文本从一个文本框移至另一个文本框。

图4:Copy、GetFromClipboard、GetText和DataObject对象示例窗体
窗体模块中的代码如下:
Dim MyData as DataObject
Private Sub CommandButton1_Click()
'在把文本复制到剪切板之前,需要选定一段文本
TextBox1.SelStart = 0
TextBox1.SelLength = TextBox1.TextLength
TextBox1.Copy
MyData.GetFromClipboard
TextBox2.Text = MyData.GetText(1)
End Sub
Private Sub UserForm_Initialize()
Set MyData = New DataObject
TextBox1.Text = "移动数据到剪贴板,然后到DataObject,接着到另一文本框!"
End Sub
- 列表框控件、DataObject对象、MouseMove事件和StartDrag方法、SetText方法示例
本示例使用DataObject对象来包含拖动文本,演示从一个列表框到另一个列表框的拖放操作。在MouseMove事件中使用SetText方法和StartDrag方法来完成拖放操作。
示例窗体如下图5所示,带有两个列表框。

图5:从一个列表框中拖动数据并放置到另一个列表框中
窗体模块代码如下:
Private Sub ListBox2_BeforeDragOver(ByVal Cancel As _
MSForms.ReturnBoolean, ByVal Data As _
MSForms.DataObject, ByVal X As Single, _
ByVal Y As Single, ByVal DragState As Long, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
Cancel = True
Effect = 1
End Sub
Private Sub ListBox2_BeforeDropOrPaste(ByVal _
Cancel As MSForms.ReturnBoolean, _
ByVal Action As Long, ByVal Data As _
MSForms.DataObject, ByVal X As Single, _
ByVal Y As Single, ByVal Effect As _
MSForms.ReturnEffect, ByVal Shift As Integer)
Cancel = True
Effect = 1
ListBox2.AddItem Data.GetText
End Sub
Private Sub ListBox1_MouseMove(ByVal Button As _
Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)
Dim MyDataObject As DataObject
If Button = 1 Then
Set MyDataObject = New DataObject
Dim Effect As Integer
MyDataObject.SetText ListBox1.Value
Effect = MyDataObject.StartDrag
End If
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
For i = 1 To 10
ListBox1.AddItem "Choice " _
& (ListBox1.ListCount + 1)
Next i
End Sub
- DataObject对象和“剪贴板”的区别
DataObject对象和“剪贴板”都提供了将数据从一处移到另一处的方法。作为应用程序开发人员,无论是使用DataObject对象还是使用“剪贴板”,都要记住下列几项要点:
示例文档下载: