初学ADO献上小作《电话簿管理系统》

ljx63426

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 ... [/quote]
楼主,您真是大好人,我的问题,您圆满解决了,太感谢您了,而且难能可贵的是您还对代码进行了注释,让我明白各条代码的意思.因为我刚学VBA,红色的代码,我还是看不懂,请您再给我注释一下,好吗?我实在太菜了,不好意思.

zhaogang1960

原帖由 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)

2010-5-9 20:47 上传

点击文件名下载附件

[ 本帖最后由 zhaogang1960 于 2010-5-9 20:47 编辑 ]

hshwxm

特别好用哦！！！！！

FXSHENG

老师新作，好用！
改天挪作他用。
感谢老师分享！

ZDYCTD

正需要，先借用！

onthetrip

很想学习ADO,一定花时间好好学习一下大师的作品

lgcmeli

真的不错哦。谢谢楼主分享。

zyff

老师大作，实用！
感谢老师分享！

blackttea

zhaogang1960的帖子,我一定顶一下,谢谢分享!

[ 本帖最后由 blackttea 于 2010-5-10 12:53 编辑 ]

lrxlrxlrxlrx

非常感谢楼主的分享..