| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 444 人关注过本帖
标题:请高手指点,在工程中加一个查询按钮
只看楼主 加入收藏
xingxingd32
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2010-3-20
收藏
 问题点数:0 回复次数:0 
请高手指点,在工程中加一个查询按钮
本贴中所提到的问题已解决,在界面中增加一个命令按钮,输入如下代码:
程序代码:
Private Sub Command5_Click()
Dim str As String
    str = InputBox("请输入要查询的姓名关键子:", "查询")
    str = "Select * From xinhetel Where 姓名 Like '%" & str & "%'"
    Adodc1.RecordSource = str
    Adodc1.Refresh

End Sub
源文件如下:
XINHEBOOX.rar (21.72 KB)



本人模仿VB神童示例,修改了一个通讯录,发现其它功能都还行,如果数据多了,查询就不好用,可否请那位高手帮忙看下加个查询按钮,按‘姓名’条件查询。界面如下:
设计界面:
图片附件: 游客没有浏览图片的权限,请 登录注册

使用的是ACCESS数据源,设计界面如下:
图片附件: 游客没有浏览图片的权限,请 登录注册

运行后的界面:
图片附件: 游客没有浏览图片的权限,请 登录注册

下面是源代码:

程序代码:
Private Sub about_Click()
MsgBox ("这是公司的通讯录,您可对其进行添加、修改、删除等维护操作")
End Sub

Private Sub delete_Click()
If Not IsNumeric(Text1.Text) Or Val(Text1.Text) = 0 Then


  MsgBox "请输入正确的编号!"

  Exit Sub

End If

Dim sc As Integer

sc = MsgBox("确实要删除这个记录吗?", vbOKCancel, "删除确认!")

If sc = 1 Then



  Dim conn As New ADODB.Connection

  Dim rs As New ADODB.Recordset

  Dim Str1 As String
     
  Dim Str2 As String
     
  Dim Str3 As String
     
  Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
     
  Str2 = "Data Source=U:\xinheboox\xinhetel.mdb;"
     
  Str3 = "Jet OLEDB:Database Password="

  conn.Open Str1 & Str2 & Str3

  strSQL = "select * from xinhetel where 编号=" & Val(Text1.Text) & ""

  rs.Open strSQL, conn, 3, 3

  If rs!编号 = Val(Text1.Text) Then

 

 
  
    rs.delete

    rs.Close

    conn.Close

    MsgBox ("删除记录成功!")

    Adodc1.Refresh

  Else

    MsgBox ("不存在此记录!")

    Text1.Text = ""

    rs.Close

    conn.Close

  Exit Sub

  End If

End If

Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End Sub



Private Sub exit_Click()
MsgBox ("你真的要退出吗")
Unload Me
End Sub

Private Sub Form_Load()
  Form1.MS1.ColWidth(0) = 800
  Form1.MS1.ColWidth(1) = 800
  Form1.MS1.ColWidth(2) = 1000
  Form1.MS1.ColWidth(3) = 1500
  Form1.MS1.ColWidth(4) = 1500
  Form1.MS1.ColWidth(5) = 2000
  Form1.Text1.Text = ""
  Form1.Text2.Text = ""
  Form1.Text3.Text = ""
  Form1.Text4.Text = ""
  Form1.Text5.Text = ""
  Form1.Text6.Text = ""
End Sub

Private Sub Command1_Click()
Dim sc As Integer

If Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text6.Text = "" Then

 

   MsgBox ("请在各栏目输入信息后点击添加记录按钮")

Else

   sc = MsgBox("确实要添加这条记录吗?", vbOKCancel, "提示信息")
  
   If sc = 1 Then
  
  

      Dim conn As New ADODB.Connection

      Dim rs As New ADODB.Recordset
     
      Dim Str1 As String
     
      Dim Str2 As String
     
      Dim Str3 As String
     
      Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
     
      Str2 = "Data Source=U:\XINHEBOOX\XINHETEL.mdb;"
     
      Str3 = "Jet OLEDB:Database Password="

      conn.Open Str1 & Str2 & Str3

      strSQL = "select * from xinhetel"

      rs.Open strSQL, conn, 3, 3

      rs.AddNew

      rs!姓名 = Text2.Text
      rs!部门 = Text3.Text
      rs!职务 = Text4.Text
      rs!手机 = Text5.Text
      rs!备注 = Text6.Text
      rs.Update
      rs.Close
      conn.Close

      MsgBox ("添加记录成功!")

      Adodc1.Refresh
     
       

   End If
   


Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End If

End Sub

Private Sub Command2_Click()
If Not IsNumeric(Text1.Text) Or Val(Text1.Text) = 0 Then


  MsgBox "请输入正确的编号及修改的信息"

  Exit Sub

End If

If Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Then



  MsgBox "请输入完整的信息!"

  Exit Sub

End If

Dim sc As Integer

 
sc = MsgBox("确实修改这条记录吗?", vbOKCancel, "提示信息")

If sc = 1 Then



   Dim conn As New ADODB.Connection

   Dim rs As New ADODB.Recordset

   Dim Str1 As String
     
   Dim Str2 As String
     
   Dim Str3 As String
     
   Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
     
   Str2 = "Data Source=U:\XINHEBOOX\XINHETEL.mdb;"
     
   Str3 = "Jet OLEDB:Database Password="

   conn.Open Str1 & Str2 & Str3
  
   strSQL = "select * from xinhetel where 编号=" & Val(Text1.Text) & ""

   rs.Open strSQL, conn, 3, 3

   If rs!编号 = Val(Text1.Text) Then
  
  

      rs!姓名 = Text2.Text
      rs!部门 = Text3.Text
      rs!职务 = Text4.Text
      rs!手机 = Text5.Text
      rs!备注 = Text6.Text
      rs.Update
      rs.Close
      conn.Close
      MsgBox ("修改记录成功!")
      Adodc1.Refresh

  Else
    
      MsgBox ("不存在此记录!")
     
      Text1.Text = ""
     
      Text2.Text = ""
     
      Text3.Text = ""
     
      Text4.Text = ""

      Text5.Text = ""
     
      Text6.Text = ""

      rs.Close

      conn.Close

      Exit Sub

  End If

End If

Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End Sub

Private Sub Command3_Click()
If Not IsNumeric(Text1.Text) Or Val(Text1.Text) = 0 Then

  MsgBox "请输入正确的编号!"

  Exit Sub

End If

Dim sc As Integer

sc = MsgBox("确实要删除这个记录吗?", vbOKCancel, "删除确认!")

If sc = 1 Then


  Dim conn As New ADODB.Connection

  Dim rs As New ADODB.Recordset

  Dim Str1 As String
     
  Dim Str2 As String
     
  Dim Str3 As String
     
  Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
     
  Str2 = "Data Source=U:\xinheboox\xinhetel.mdb;"
     
  Str3 = "Jet OLEDB:Database Password="

  conn.Open Str1 & Str2 & Str3

  strSQL = "select * from xinhetel where 编号=" & Val(Text1.Text) & ""

  rs.Open strSQL, conn, 3, 3

  If rs!编号 = Val(Text1.Text) Then

 
  
    rs.delete

    rs.Close

    conn.Close

    MsgBox ("删除记录成功!")

    Adodc1.Refresh

  Else

    MsgBox ("不存在此记录!")

    Text1.Text = ""

    rs.Close

    conn.Close

  Exit Sub

  End If

End If
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End Sub

Private Sub Command4_Click()

Dim sc As Integer

sc = MsgBox("确实要退出系统吗?", vbOKCancel, "提示信息")

If sc = 1 Then


  End

 
End If

End Sub

Private Sub tianjia_Click()
Dim sc As Integer

If Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text6.Text = "" Then

   MsgBox ("请在各栏目输入信息后点击添加记录按钮")

Else

   sc = MsgBox("确实要添加这条记录吗?", vbOKCancel, "提示信息")
  
   If sc = 1 Then
   

      Dim conn As New ADODB.Connection

      Dim rs As New ADODB.Recordset
     
      Dim Str1 As String
     
      Dim Str2 As String
     
      Dim Str3 As String
     
      Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
     
      Str2 = "Data Source=U:\XINHEBOOX\XINHETEL.mdb;"
     
      Str3 = "Jet OLEDB:Database Password="

      conn.Open Str1 & Str2 & Str3

      strSQL = "select * from xinhetel"

      rs.Open strSQL, conn, 3, 3

      rs.AddNew

      rs!姓名 = Text2.Text
      rs!部门 = Text3.Text
      rs!职务 = Text4.Text
      rs!手机 = Text5.Text
      rs!备注 = Text6.Text
      rs.Update
      rs.Close
      conn.Close

      MsgBox ("添加记录成功!")

      Adodc1.Refresh
      

   End If
   

Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End If

End Sub

Private Sub xiougai_Click()
If Not IsNumeric(Text1.Text) Or Val(Text1.Text) = 0 Then


  MsgBox "请输入正确的编号及修改的信息"

  Exit Sub

End If

If Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Then


  MsgBox "请输入完整的信息!"

  Exit Sub

End If

Dim sc As Integer

 
sc = MsgBox("确实修改这条记录吗?", vbOKCancel, "提示信息")

If sc = 1 Then


   Dim conn As New ADODB.Connection

   Dim rs As New ADODB.Recordset

   Dim Str1 As String
     
   Dim Str2 As String
     
   Dim Str3 As String
     
   Str1 = "Provider=Microsoft.Jet.OLEDB.4.0;"
     
   Str2 = "Data Source=U:\XINHEBOOX\XINHETEL.mdb;"
     
   Str3 = "Jet OLEDB:Database Password="

   conn.Open Str1 & Str2 & Str3
  
   strSQL = "select * from xinhetel where 编号=" & Val(Text1.Text) & ""

   rs.Open strSQL, conn, 3, 3

   If rs!编号 = Val(Text1.Text) Then
   

      rs!姓名 = Text2.Text
      rs!部门 = Text3.Text
      rs!职务 = Text4.Text
      rs!手机 = Text5.Text
      rs!备注 = Text6.Text
      rs.Update
      rs.Close
      conn.Close
      MsgBox ("修改记录成功!")
      Adodc1.Refresh
  Else
    
      MsgBox ("不存在此记录!")
     
      Text1.Text = ""
     
      Text2.Text = ""
     
      Text3.Text = ""
     
      Text4.Text = ""

      Text5.Text = ""
     
      Text6.Text = ""

      rs.Close

      conn.Close

      Exit Sub

  End If

End If

Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
End Sub 

Private Sub Command5_Click()
Dim str As String
    str = InputBox("请输入要查询的姓名关键子:", "查询")
    str = "Select * From xinhetel Where 姓名 Like '%" & str & "%'"
    Adodc1.RecordSource = str
    Adodc1.Refresh

End Sub



[ 本帖最后由 xingxingd32 于 2010-4-2 12:25 编辑 ]
搜索更多相关主题的帖子: 查询 按钮 工程 
2010-04-02 10:18
快速回复:请高手指点,在工程中加一个查询按钮
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.027563 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved