⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form2.frm

📁 为一个单位的老师写的小工具
💻 FRM
📖 第 1 页 / 共 2 页
字号:
            Left            =   240
            Style           =   2  'Dropdown List
            TabIndex        =   6
            Top             =   360
            Width           =   1455
         End
      End
      Begin VB.CheckBox Check3 
         Caption         =   "在上次的结果中查询"
         Height          =   975
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   1095
      End
      Begin VB.CommandButton Command1 
         Caption         =   "执行查询"
         Height          =   735
         Left            =   2400
         TabIndex        =   1
         Top             =   480
         Width           =   855
      End
   End
   Begin MSAdodcLib.Adodc Adodc2 
      Height          =   375
      Left            =   240
      Top             =   8640
      Width           =   2055
      _ExtentX        =   3625
      _ExtentY        =   661
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc2"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   375
      Left            =   2280
      Top             =   8640
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   661
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.Label Label2 
      Caption         =   "提示:双击查询结果的行,可以打开修改窗口,修改该行的值。修改完成后请点击右边的刷新按钮"
      Height          =   375
      Left            =   240
      TabIndex        =   40
      Top             =   4560
      Width           =   8175
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim qSTR, vSTR, orderSTR As String
'保存查询条件的sql语句


Private Sub Combo3_Click()
   changeOrder
End Sub

Private Sub Command1_Click()
'查询按钮
On Error GoTo eee
  '执行错误处理
  
  
 '嵌套查询
 If Check3.Value = False Then
   qSTR = " where "
 Else
   qSTR = qSTR & " and ( "
 End If
 makeQ (0)
   
 
 '分别根据选定条件附加sql语句
 
 If Frame3.Enabled Then
   makeQ (1)
   '事后修补难免拖沓请原谅
   If Text1(1).Text = "" Then
     qSTR = " "
     MsgBox "条件不可以为空!!"
     GoTo n2
   End If
 End If
   
 If Frame4.Enabled Then
   makeQ (2)
   If Text1(2).Text = "" Then
     qSTR = " "
     MsgBox "条件不可以为空!!"
     GoTo n2
   End If
 End If
     
 If Frame5.Enabled Then
   makeQ (3)
   If Text1(3).Text = "" Then
     qSTR = " "
     MsgBox "条件不可以为空!!"
     GoTo n2
   End If
 End If
         
 If Check3.Value = False Then
   
 Else
   qSTR = qSTR & " ) "
 End If
 ' MsgBox qSTR
   
   
   '刷新显示
    refreshQ
   
   '查询后,在结果中查询可用
    Check3.Enabled = True
    
 
 GoTo n2
eee:
 
    MsgBox Err.Description
n2:
End Sub

Private Sub makeQ(Index As Integer)
 '针对后第index个条件生成检索sql表达式
  
  If (Index > 0) Then
    If Option2(Index - 1) Then
        qSTR = qSTR & " OR "
    Else
        qSTR = qSTR & " AND "
    End If
  End If
  
  
 
  
  qSTR = qSTR & Combo1(Index).Text
   
  Select Case Combo2(Index).Text
  Case "模糊等于":
    qSTR = qSTR & " like '%" + Trim(Text1(i).Text) + "%'"
  Case "等于"
    qSTR = qSTR & " like '" + Trim(Text1(i).Text) + "' "
  Case "大于"
    qSTR = qSTR & " > " + Trim(Text1(i).Text) + ""
  Case "小于"
    qSTR = qSTR & " < " + Trim(Text1(i).Text) + ""
  End Select
  
  '调试用
  ' MsgBox qSTR
  
End Sub

Private Sub Command2_Click()
 
 Frame3.Enabled = False
 Frame4.Enabled = False
 Frame5.Enabled = False
 
 For i = 0 To 2
   Option1(i).Value = False
   Option2(i).Value = False
 Next i

End Sub

Private Sub Command3_Click()
   Form6.Show 1
   '检查是否没有选择任何东西
   If Trim(itemC(0)) <> "" Then
       vSTR = Trim(itemC(0))
   End If
   '检查是否只是选择了一个东西
   If countA > 0 Then
    For i = 1 To countA - 1
   
     Label1.Caption = Label1.Caption + itemC(i) + "+"
        If Trim(itemC(i)) <> "" Then
          vSTR = vSTR & "," & itemC(i)
        End If
    Next i
   End If
   
   refreshQ
End Sub

Private Sub Command4_Click()
  vSTR = " * "
End Sub

Private Sub Command5_Click()
   refreshQ
End Sub

Private Sub Command6_Click()
 '  Adodc1.RecordSource = "select  id," & vSTR & "  from tblXUESHENG " & qSTR & orderSTR
 ' MsgBox "select  " & vSTR & "  from tblXUESHENG " & qSTR '
 Xstr = "select  id," & vSTR & "  from tblXUESHENG " & qSTR & orderSTR
 Form10.Show 1
End Sub

Private Sub DataGrid1_DblClick()
    
On Error GoTo AddErr
    DataGrid1.Col = 0
    selectID = DataGrid1.Text
 '   MsgBox selectID
      
    '显示修改窗体
    Form3.Show 1
    
    '刷新显示
    refreshQ
    
GoTo aaaa
AddErr:
     MsgBox Err.Description
aaaa:
End Sub

Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
 MsgBox "如果您希望删除或修改条目的内容,请在条目上双击鼠标左键,在弹出的对话框中修改,直接的修改无效"
 refreshQ
 'DataGrid1.SetFocus
End Sub
Private Sub refreshQ()
   Adodc1.RecordSource = "select  id," & vSTR & "  from tblXUESHENG " & qSTR & orderSTR
   MsgBox "检索表达式为:select  " & vSTR & "  from tblXUESHENG " & qSTR '
   Adodc1.Refresh
End Sub
Private Sub Form_Load()
   Me.Left = (Screen.Width - Me.Width) / 2     '使窗体居中
   Me.Top = (Screen.Height - Me.Height) / 2
   
   innit
   Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\招聘信息.mdb;Persist Security Info=False"
   qSTR = ""
  
  ' refreshQ
  '如果在load中刷新控件会造成首行首列丢失的错误 同时在这时也无法设置控件的焦点
   
  
   
   
   
   
   
   
 '   Dim connStr, AccessLocation As String
  '  AccessLocation = App.Path & "\abc.xls"
  '  connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessLocation & ";Extended Properties='Excel 8.0'"  ';HDR=Yes';"
  '  Adodc2.ConnectionString = connStr
    'Adodc2.CommandType = adCmdText
  '  Adodc2.RecordSource = "select * from [abc]"
   '   Adodc2.Refresh
   ' 以这种方式试图直接连接cls表没有成功, !!! 不过97 2000 应该没问题 8.0  实验 9.0 10.0都没有安装!
 
  
End Sub
Private Sub innit()

 

 '首次,在结果中查询不可用
    Check3.Enabled = False
 '初始化查询条件的下拉列表
    Dim Name As Variant
    Name = Array("姓名", "ID", "性别", "民族", "出生年月", "毕业院校", "最后学历", "专业", "工作经历", "备注")
 '
    vSTR = "*"
    orderSTR = " order by ID asc"
    
    Dim symbo As Variant
    symbo = Array("模糊等于", "等于", "大于", "小于")
    
  
     
     
     
     
    Adodc3.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\招聘信息.mdb;Persist Security Info=False"
    Adodc3.RecordSource = "select  count(*)   from tblCol   "
    Adodc3.Refresh
    Dim cooon As Integer
    cooon = Adodc3.Recordset.Fields(0)
    
    Adodc3.RecordSource = "select  名称   from tblCol   "
    Adodc3.Refresh
    
    For i = 0 To 3
       For j1 = 0 To cooon - 1
         If (Adodc3.Recordset.Fields(0) <> "") Then
            Combo1(i).AddItem Trim(Adodc3.Recordset.Fields(0))
            If i = 0 Then
                Combo3.AddItem Trim(Adodc3.Recordset.Fields(0))
            End If
         
         End If
         
         Adodc3.Recordset.MoveNext
         Next j1
       For j2 = 0 To 3
         Combo2(i).AddItem Trim(symbo(j2))
       Next j2
         
         'Combo3.AddItem
       Adodc3.Recordset.MoveFirst
     Next i
    
    
    For j1 = 0 To cooon - 1
       If Adodc3.Recordset.Fields(0) <> Null Then Combo3.AddItem Trim(Adodc3.Recordset.Fields(0))
        Adodc3.Recordset.MoveNext
    Next j1
     
     
End Sub

Private Sub Option1_Click(Index As Integer)
'控制查询条件
Select Case Index
   Case 0:
     Frame3.Enabled = True
   Case 1:
     Frame4.Enabled = True
   Case 2:
     Frame5.Enabled = True
   End Select
End Sub

Private Sub Option2_Click(Index As Integer)
'控制查询条件
Select Case Index
   Case 0:
     Frame3.Enabled = True
   Case 1:
     Frame4.Enabled = True
   Case 2:
     Frame5.Enabled = True
   End Select
End Sub

Private Sub Option3_Click()
changeOrder
End Sub

Private Sub Option4_Click()
changeOrder
End Sub
Private Sub Combo3_Change()
   changeOrder
End Sub
Private Sub changeOrder()
   If Option3.Value Then
      orderSTR = "order by " & Trim(Combo3.Text) & " asc"
   End If
   If Option4.Value Then
      orderSTR = "order by " & Trim(Combo3.Text) & " desc"
   End If
   
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -