|
|
楼主 |
发表于 2010-5-9 18:21
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
原帖由 ljx63426 于 2010-5-9 17:24 发表 
10组为一列：
Private Sub UserForm_Initialize()
Dim SQL$, i&, j&, arr, a(), k, m%, n%
With Sheet2
arr = .Range("A2").CurrentRegion
ReDim a(UBound(arr, 2) - 1)
Fo . ...
我对代码进行了修改，不再是10行一列，本例共有12个字段，6行一列比较合适
顺便说一句，工作简历使用一个文本框就可以了，因为文本框可以回车换行，附件只加上了回车换行功能
Private Sub UserForm_Initialize()
Dim SQL$, i&, j&, arr, a(), m%, n%, l%
With Sheet2
arr = .Range("A2").CurrentRegion
ReDim a(UBound(arr, 2) - 1)
For i = 0 To UBound(a)
a(i) = .Columns(i + 1).ColumnWidth * 6.5 'ListView1各列列宽
Next
End With
Set cnn = New ADODB.Connection
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
SQL = "select * from [数据库$] "
Set rs = New ADODB.Recordset
rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
On Error Resume Next
l = WorksheetFunction.RoundUp(rs.Fields.Count / 2, 0) '动态添加文本框行数(2列情况下),本例共有12个字段,l=6
With ListView1
' 设置ListView1的标题,显示类型,整行选择和网格线属性
.ColumnHeaders.Clear
.View = lvwReport ' listivew的显示格式为报表格式
.FullRowSelect = True ' 允许整行选中
.Gridlines = True ' 显示网格线
' 为ListView1设置标题
For i = 0 To rs.Fields.Count - 1
m = i Mod l '求余数,决定控件的纵坐标
n = Int(i / l) * 210 '求整数，,决定控件的横坐标
With Controls.Add("Forms.Label.1", "Label" & i + 1, True) '动态添加标签控件
.Move 570 + n, 60 * (m + 1) '前面是X(距左边的距离)，后面是Y(距上边的距离)
.Caption = rs.Fields(i).Name '显示字段名
.Width = 50 '宽度
End With
With Controls.Add("Forms.TextBox.1", "TextBox" & i + 1, True) '动态添加文本框控件
.Move 620 + n, 60 * (m + 1)
.Width = 150
.Height = 50
If InStr(rs.Fields(i).Name, "工作简历") Then '对工作简历字段设置
.MultiLine = True '文本框多行
.EnterKeyBehavior = True '文本框接受回车键
End If
End With
If i > 0 Then
.ColumnHeaders.Add , , rs.Fields(i).Name, a(i), lvwColumnCenter '从第2列起居中
Else
.ColumnHeaders.Add , , rs.Fields(i).Name, a(i)
End If
Next i
End With
Call 显示数据(SQL) '为ListView1设置各行数据
'arr = cnn.Execute("select distinct " & rs.Fields(i - 1).Name & " from [数据库$] where " & rs.Fields(i - 1).Name & " is not null ").GetRows '不重复的工作部门，为了修改字段名后不受影响使用了rs.Fields(i - 1).Name来代替“工作部门”
'ComboBox1.List = WorksheetFunction.Transpose(arr) '不重复的工作部门赋值给组合框
模糊查询.SetFocus
End Sub
电话簿管理系统(以本工作簿工作表为数据库)动态控件3(文本框多行回车键).rar
(37.48 KB, 下载次数: 804)
[ 本帖最后由 zhaogang1960 于 2010-5-9 20:47 编辑 ] |
|
楼主: zhaogang1960
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-5-9 17:24
