自己编制的，共享一下： 模块1：（代码） Dim btopDim bleft Public Function GetDatabaseName() GetDatabaseName = "DBQ=D:\INETPUB\WWWROOT\jshb\test.mdb;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"End Function Public Sub InitPage()btop = 4bleft = 2End Sub Public Sub TitleName()  Cells(btop, bleft) = "id"  Cells(btop, bleft + 1) = "type"  Cells(btop, bleft + 2) = "姓名"  Cells(btop, bleft + 3) = "公司"  Cells(btop, bleft + 4) = "座机"  Cells(btop, bleft + 5) = "手机"  Cells(btop, bleft + 6) = "传真"  Cells(btop, bleft + 7) = "职位"  Cells(btop, bleft + 8) = "Email"End Sub Public Sub ClearPage()  Dim addr  b = btop + 1  addr = "A" & b & ":Z1000"  Range(addr).ClearContentsEnd Sub Public Sub Serchmdb(ByVal SelectType, ItemContent, ItemName, st As String)  Dim cmd As String  Dim oAss As Object  Dim b    connstr = GetDatabaseName  Set oAss = CreateObject("ADODB.connection")  oAss.Open connstr  If SelectType = "all" Then    cmd = "SELECT * FROM telephone ORDER BY id DESC"  Else    cmd = "SELECT * FROM telephone WHERE " + ItemName + " like " + st + "%" + ItemContent + "%" + st  End If  On Error GoTo 0  Set rs = oAss.Execute(cmd)   ClearPage  b = btop + 1  Do While Not rs.EOF  Cells(b, bleft) = rs("id")  Cells(b, bleft + 1) = rs("type")  Cells(b, bleft + 2) = rs("姓名")  Cells(b, bleft + 3) = rs("公司")  Cells(b, bleft + 4) = rs("座机")  Cells(b, bleft + 5) = rs("手机")  Cells(b, bleft + 6) = rs("传真")  Cells(b, bleft + 7) = rs("职位")  Cells(b, bleft + 8) = rs("Email")  b = b + 1  rs.movenext  Loop  rs.Close End Sub Sheet1：（代码） Dim ItemName, SelectType As StringDim Msg, Style, Title, Ctxt, Response Private Sub Button_Delect_Click()Dim ii, acomp ii = TextId.Textacomp = TextComp.TextIf ii = "" Then  MsgBox ("ID 不能空")Else  Msg = "删除第" + ii + "段数据，确认?" ' 定义信息。  Response = MsgBox(Msg, Style, Title, Help, Ctxt)  If Response = vbYes Then    ' 用户按下“是”。    Deletemdb ii    Serchmdb "Select", acomp, "公司", "'"  End If  End IfEnd Sub Private Sub Button_Search_Click()Dim ItemContent, st As StringSelectType = "select"ItemContent = TextBox1.TextIf ItemName = "" Then  ItemName = ComboBox1.List(0)End IfIf ItemName <> "id" Then  st = "'"Else  st = ""End IfTitleNameClearPageSerchmdb SelectType, ItemContent, ItemName, stEnd Sub Private Sub Button_SelectAll_Click()Dim ItemContent, st As StringSelectType = "all"ItemContent = ""st = ""Serchmdb SelectType, ItemContent, ItemName, stEnd Sub Private Sub Button_Update_Click()Dim aid, atype, aname, acomp, ajob, aphone, amobil, afax, aemail As Stringatype = TextType.TextIf atype = "" Then  MsgBox ("Type 不能空白")Else  aid = TextId.Text  aname = TextName.Text  acomp = TextComp.Text  ajob = TextJob.Text  aphone = TextPhone.Text  amobil = TextMobil.Text  afax = TextFax.Text  aemail = TextEmail.Text   If aid = "" Then    Addmdb atype, aname, acomp, ajob, aphone, amobil, afax, aemail  Else    Msg = "修改第" + aid + "段数据，确认?" ' 定义信息。    Response = MsgBox(Msg, Style, Title, Help, Ctxt)    If Response = vbYes Then    ' 用户按下“是”。      Updatemdb aid, atype, aname, acomp, ajob, aphone, amobil, afax, aemail    End If  End If  Serchmdb "Select", acomp, "公司", "'"End IfEnd Sub Private Sub ComboBox1_Change()Dim ii = ComboBox1.ListIndexIf i < 0 Then  ItemName = ""Else  ItemName = ComboBox1.List(i)End IfEnd Sub Private Sub CommandAdd_Click()TextId.Text = ""End Sub Public Sub InitText()Style = vbYesNo + vbCritical + vbDefaultButton2    ' 定义确认框按钮。Title = "确认"    ' 定义确认框标题。Ctxt = 1000    ' 定义确认框标题 TextId.Text = ""TextType.Text = ""TextName.Text = ""TextComp.Text = ""TextJob.Text = ""TextPhone.Text = ""TextMobil.Text = ""TextFax.Text = ""TextEmail.Text = ""End Sub Public Sub addcom() With ComboBox1  .Clear  '.AddItem Cells(2, 1) '把你数据单元格的数据add到  '.AddItem Cells(2, 2) '把你数据单元格的数据add到  '.AddItem Cells(2, 3) '把你数据单元格的数据add到  .AddItem "姓名"  .AddItem "公司"  .AddItem "座机"  .AddItem "手机"  .AddItem "传真"  .AddItem "职位"  .AddItem "Email"  .AddItem "type"  .Text = .List(0)  si = .List(0)End WithEnd Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range)Straddr = Target.Cells(1, 1).AddressCol_s = Mid(Straddr, 2, 1)Row_n = Mid(Straddr, 4)If Col_s = "B" And Row_n > 4 Then  TextId.Text = Cells(Row_n, 2)  TextType.Text = Cells(Row_n, 3)  TextName.Text = Cells(Row_n, 4)  TextComp.Text = Cells(Row_n, 5)  TextPhone.Text = Cells(Row_n, 6)  TextMobil.Text = Cells(Row_n, 7)  TextFax.Text = Cells(Row_n, 8)  TextJob.Text = Cells(Row_n, 9)  TextEmail.Text = Cells(Row_n, 10)End IfEnd Sub ThisWorkBook：（代码） Private Sub Workbook_Open()Sheet1.addcomSheet1.InitTextInitPageEnd Sub

评论