在窗体中用代码动态添加控件并响应事件
excel吧
全部回复
仅看楼主
吧务
level 10
marchwen01 楼主
这是事一个窗体,只有一个控件。
这是窗体内部的代码:
代码添加了两个控件,并把这两个控件传入到类模块中,动态添加多个控件必须要用到集合
Collection
这是类模块的代码,注意代码中定义的变量。
下面两个图是窗体运行后,响应事件的样子。
2017年03月05日 04点03分 1
吧务
level 10
marchwen01 楼主
现在把代码贴上,这是添加控件最简的代码了,应该也是最容易看懂的代码了吧。
窗体的代码:
Private conCmdBut As MSForms.CommandButton
Private clsTest As New myClass
Private co As New Collection
Private Sub CommandButton1_Click()
Set conCmdBut = Controls.Add("Forms.CommandButton.1")
clsTest.Receive conCmdBut
co.Add clsTest
Set clsTest = Nothing
Set conCmdBut = Controls.Add("Forms.CommandButton.1")
conCmdBut.Left = 80
clsTest.Receive conCmdBut
co.Add clsTest
Set clsTest = Nothing
End Sub
类模块的代码:
Private WithEvents iComBut As MSForms.CommandButton
Public Sub Receive(myComBut As MSForms.CommandButton)
Set iComBut = myComBut
End Sub
Private Sub iComBut_Click()
MsgBox "Hello " & iComBut.Name
End Sub
类模块的名称是:myClass
2017年03月05日 04点03分 2
吧务
level 10
marchwen01 楼主
因为是动态添加的控件,并且要每一个控件都要响应事件,所以必须要用到集合对象。类模块在窗体的应用中是非常有用的,当一个窗体有很多相同的控件,每个控件都要响应类似的事件时,控件的事件就可以写到类模块中,代码就可以非常简结了。
2017年03月05日 04点03分 3
吧务
level 10
marchwen01 楼主
下面是用动态添加控件的方式做的一个实例,百度网盘,代码公开。
[无效] http://pan.baidu.com/s/1slm6gB7
2017年03月07日 06点03分 4
吧务
level 10
marchwen01 楼主
这是一组应收款的模拟数据。实例的作用是快速的填写收款日期。
2017年03月07日 06点03分 5
吧务
level 10
marchwen01 楼主
窗体最初的模样。因为是用代码来添加控件,所以在窗体中是看不到什么控件的。
2017年03月07日 06点03分 6
吧务
level 10
marchwen01 楼主
这是窗体内部的代码,因为贴吧不支持缩进,先贴图,图还能看得比较清楚。
2017年03月07日 06点03分 7
吧务
level 10
marchwen01 楼主
这是类模块的代码。
2017年03月07日 06点03分 8
吧务
level 10
marchwen01 楼主
标准模块,程序入口
2017年03月07日 06点03分 9
吧务
level 10
marchwen01 楼主
运行窗体的样子,把所有 没有 收款日期的数据列出来,给个 CheckBox 选择。
选择,点击确定。在工作表中 收款日期 对应的数据上填写当天的日期。
再点击刷新,过滤掉已经有收款日期(表示已经收款)的数据,等待下一步的操作。
2017年03月07日 06点03分 10
吧务
level 10
marchwen01 楼主
窗体代码:
Option Explicit
Private myCls As New MyClass '类模块变量
Private co As New Collection '集合
Public kRow As Long '记录添加内容的行数,定义成公共变量是因为在类模块中要使用
'窗体加载
Private Sub UserForm_Initialize()
'初始化 UserForm
With Me
.Caption = "收款时间录入"
.Width = 390
End With
FormsControlsAdd
End Sub
'窗体初始货,用动态添加控件的方式添加数据
Public Sub FormsControlsAdd()
Dim msCommandButtom As MSForms.CommandButton
Dim vArray As Variant
Dim lRow As Long, iCol As Integer
Dim myControl As Control
Dim lRowsCount As Long, iColumnsCount As Integer
'删除原有的控件
For Each myControl In Controls
Controls.Remove myControl.Name
Next
'获得工作表的数据 以及 行数和列数
vArray = Sheets("sheet1").Range("a1").CurrentRegion
lRowsCount = UBound(vArray, 1)
iColumnsCount = UBound(vArray, 2)
'添加标题行 --- Label 标签
For iCol = 1 To iColumnsCount - 1
With Controls.Add("Forms.Label.1")
.Width = 80 '宽度
.Left = (iCol - 1) * 80 + 8 '左边位置
.Top = 8 '顶边位置
.Height = 12 '高度(与字体大小对应)
.Font.Size = 12 '字体大小
.Caption = vArray(1, iCol) '标签显示的内容
.Font.Bold = True '字体加粗
.BackColor = vbYellow '背景色
.TextAlign = fmTextAlignCenter '居中显示内容
End With
Next
'添加标题行的最后一列 --- Label 标签
With Controls.Add("Forms.Label.1")
.Width = 50
.Left = (iCol - 1) * 80 + 8
.Top = 8
.Height = 12
.Font.Size = 12
.Caption = "选择框"
.Font.Bold = True
.BackColor = vbYellow
.TextAlign = fmTextAlignCenter
End With
'下面添加数据内容 --- Label 标签
kRow = 0 '行数初始化
For lRow = 2 To lRowsCount
If vArray(lRow, 5) = "" Then '如果收款日期为空
kRow = kRow + 1 '行数累加
Me.Height = (kRow + 1) * 10 + 80
For iCol = 1 To iColumnsCount - 1
With Controls.Add("Forms.Label.1")
.Width = 80
.Left = (iCol - 1) * 80 + 8
.Top = (kRow - 1) * 10 + 20
.Height = 10
.Font.Size = 9
.Caption = vArray(lRow, iCol)
.TextAlign = fmTextAlignCenter
'隔行着色
If kRow Mod 2 = 0 Then
.BackColor = RGB(222, 222, 222)
Else
.BackColor = RGB(20, 100, 150)
.ForeColor = RGB(200, 200, 0)
End If
End With
Next
'添加最后一列的 CheckBox
With Controls.Add("Forms.CheckBox.1")
.Width = 50
.Left = (iCol - 1) * 80 + 8
.Top = (kRow - 1) * 10 + 20
.Height = 10
.Font.Size = 10
.Caption = lRow
.TextAlign = fmTextAlignCenter
'.SpecialEffect = fmButtonEffectFlat
If kRow Mod 2 = 0 Then
.BackColor = RGB(222, 222, 222)
.ForeColor = RGB(222, 222, 222)
Else
.BackColor = RGB(20, 100, 150)
.ForeColor = RGB(20, 100, 150)
End If
End With
End If
Next
'添加CommandButton
Set msCommandButtom = Controls.Add("Forms.CommandButton.1")
With msCommandButtom
.Name = "Update"
.Left = 8
.Top = (kRow + 2) * 10 + 10
.Caption = "刷新"
End With
myCls.AcceptButton msCommandButtom
co.Add myCls
Set myCls = Nothing
Set msCommandButtom = Controls.Add("Forms.CommandButton.1")
With msCommandButtom
.Name = "Ok"
.Left = 200
.Top = (kRow + 2) * 10 + 10
.Caption = "确定"
End With
myCls.AcceptButton msCommandButtom
co.Add myCls
Set myCls = Nothing
Set msCommandButtom = Controls.Add("Forms.CommandButton.1")
With msCommandButtom
.Name = "Close"
.Left = 290
.Top = (kRow + 2) * 10 + 10
.Caption = "关闭"
End With
myCls.AcceptButton msCommandButtom
co.Add myCls
Set myCls = Nothing
End Sub
2017年03月07日 06点03分 11
初始化,写成了初始货。。。
2017年03月07日 06点03分
吧务
level 10
marchwen01 楼主
类模块代码:
Option Explicit
Private WithEvents msBtn As MSForms.CommandButton
Public Sub AcceptButton(ByVal Btn As MSForms.CommandButton)
Set msBtn = Btn
End Sub
Private Sub msBtn_Click()
Dim lRow As Long
With UserForm1
Select Case msBtn.Name
Case "Update"
.FormsControlsAdd
Case "Ok"
For lRow = 1 To .kRow
If .Controls("CheckBox" & lRow).Value = True Then
Sheets("sheet1").Cells(.Controls("CheckBox" & lRow).Caption, 5) = Date
End If
Next
Case "Close"
Unload UserForm1
End Select
End With
End Sub
2017年03月07日 06点03分 12
吧务
level 10
marchwen01 楼主
只是操作工作表的数据,做一个这样的窗体显得有点小题大作,如果用Excel联接数据库,并且操作,这是有很大的方便的。
2017年03月07日 06点03分 13
吧务
level 10
marchwen01 楼主
@轻舟上逆 来围观下。
2017年03月07日 07点03分 14
level 12
收藏,慢慢学
2017年03月07日 07点03分 15
1 2 尾页