吧务
level 10
现在把代码贴上,这是添加控件最简的代码了,应该也是最容易看懂的代码了吧。
窗体的代码:
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
因为是动态添加的控件,并且要每一个控件都要响应事件,所以必须要用到集合对象。类模块在窗体的应用中是非常有用的,当一个窗体有很多相同的控件,每个控件都要响应类似的事件时,控件的事件就可以写到类模块中,代码就可以非常简结了。
2017年03月05日 04点03分
3
吧务
level 10
窗体代码:
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
类模块代码:
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
只是操作工作表的数据,做一个这样的窗体显得有点小题大作,如果用Excel联接数据库,并且操作,这是有很大的方便的。
2017年03月07日 06点03分
13