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

zhaogang1960

winsome012 发表于 2015-1-13 17:50
我没解释清楚，不知道可不可以，我想将另外六个文本框中的一个改成可以使用下拉菜单的combobox，比如在添加 ...

请参考：
电话簿管理系统(以本工作簿工作表为数据库).rar (34.09 KB, 下载次数: 101)

2015-1-13 19:51 上传

点击文件名下载附件

winsome012

非常感谢赵老师,不过我想要的是可以设置List的combobox,比如部门只允许输入“部门A,部门B,部门C"。还需要一个textbox可以输入大量的文字，不知道能不能实现。
再次感谢。

zhaogang1960

winsome012 发表于 2015-1-14 14:00
非常感谢赵老师,不过我想要的是可以设置List的combobox,比如部门只允许输入“部门A,部门B,部门C"。还需要一 ...

combobox全部设置了List，就是数据库中该字段的所有不重复记录，如果你有新的要求，可存放在一个工作表的某列中作为它的List
第二个问题不知所云

winsome012

zhaogang1960 发表于 2015-1-14 14:52
combobox全部设置了List，就是数据库中该字段的所有不重复记录，如果你有新的要求，可存放在一个工作表的 ...

-》如果你有新的要求，可存放在一个工作表的某列中作为它的List。
请问如何做到这点，能帮忙在改一下代码吗？
-》第二个问题是指，我想混合combobox和textbox,比如3个combobox和3个textbox。
-》Private Sub 添加记录_Click()
    Dim rst As ADODB.Recordset
    Dim i&, SQL$, temp$
    For i = 1 To 6 Step 1 '这里设置姓名和工作部门字段不能为空
        If Me.Controls("TextBox" & i).Text = "" Then
            MsgBox rs.Fields(i - 1).Name & "不能为空！", vbCritical
            Me.Controls("TextBox" & i).SetFocus
            Exit Sub
        End If
       ' temp = temp & " and " & rs.Fields(i - 1).Name & " = " & "'" & Me.Controls("TextBox" & i).Text & "'" '姓名和工作部门都相同的视为同一个人
    Next i
    abcc = MsgBox("增加  “" & Me.Controls("TextBox1").Text & "”i确认？", vbYesNo, "Note")
If abcc <> vbYes Then
Exit Sub
End If
    On Error Resume Next
    Set rst = New ADODB.Recordset
    SQL = "select * from data where " & Mid(temp, 5)   请问这句中的Mid(temp, 5) 是什么意思？
请赵老师受累帮忙回答下。

zhaogang1960

winsome012 发表于 2015-1-14 15:51
-》如果你有新的要求，可存放在一个工作表的某列中作为它的List。
请问如何做到这点，能帮忙在改一下代码 ...

保留你想用的combobox，不用的删除用textbox代替
把各个combobox的List写在一个新的工作表的某列中

达州张先生

第3个附件有一个小小缺陷，窗体显示过大，刚好屏幕大小就好了（可以缩小左边的显示框），因为在录入用户资料时，要移动屏幕，这样很不方便，谢谢老师奉献！
另：为什么右边的一部分窗体内的窗口不能显示呢，如果能显示右边的录入框的话，就可以自己根据需要调整窗体大小了。多谢

达州张先生

zhaogang1960 发表于 2015-1-14 14:52
combobox全部设置了List，就是数据库中该字段的所有不重复记录，如果你有新的要求，可存放在一个工作表的 ...

老师你好，我（下载后）发现1楼的第一个附件不能录入数据，只能录入姓名，不知何故，另在手机号后面插入一列"短号"列，在右边增加一个“短号”录入窗口更好。多谢分享！

zhaogang1960

达州张先生 发表于 2015-1-21 23:42
老师你好，我（下载后）发现1楼的第一个附件不能录入数据，只能录入姓名，不知何故，另在手机号后面插入一 ...

请看演示

feiren228

zhaogang1960 发表于 2015-1-21 23:54
请看演示

赵老师，再请教个ado向工作薄插入数据的问题
Sub ado2()
    '需引用Microsoft ActiveX Data Objects 2.0 Library以上
    Dim cnn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sql As String
    dataname = ThisWorkbook.Path & "\目标表.xls"
    If Application.Version * 1 <= 11 Then
        cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=yes';data source=" & ActiveWorkbook.FullName
    Else
        cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;hdr=yes';data source=" & ActiveWorkbook.FullName
    End If
    sql = "insert into [" & dataname & "].[sheet1] select  *  from [sheet1$];"
    cnn.Execute sql
    'rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub
这段代码一直会出错

zhaogang1960

feiren228 发表于 2015-1-22 00:08
赵老师，再请教个ado向工作薄插入数据的问题
Sub ado2()
    '需引用Microsoft ActiveX Data Objects 2 ...

1. Sub Macro1()
   
2.     '需引用Microsoft ActiveX Data Objects 2.0 Library以上
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim sql As String
   
5.     dataname = ThisWorkbook.Path & "\目标表.xls"
   
6.     If Application.Version * 1 <= 11 Then
   
7.         cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=yes';data source=" & ActiveWorkbook.FullName
   
8.     Else
   
9.         cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;hdr=yes';data source=" & ActiveWorkbook.FullName
   
10.     End If
    
11.     sql = "select * into [Excel 8.0;Database=" & dataname & "].[sheet1] from [sheet1$];'Excel 8.0指定工作簿类型，以免在2007以上版本中生成的xls文件用2003打不开"
    
12.     cnn.Execute sql
    
13.     cnn.Close
    
14.     Set cnn = Nothing
    
15. End Sub
    

复制代码