📄 form7.frm
字号:
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = "ZJHM"
Caption = "证件号码"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column02
DataField = "zt"
Caption = "状态"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 5
Format = ""
HaveTrueFalseNull= 1
TrueValue = "T"
FalseValue = "F"
NullValue = "F"
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column03
DataField = "JDJX"
Caption = "驾校"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
Locked = -1 'True
BeginProperty Column00
ColumnWidth = 1244.976
EndProperty
BeginProperty Column01
ColumnWidth = 2459.906
EndProperty
BeginProperty Column02
ColumnWidth = 734.74
EndProperty
BeginProperty Column03
EndProperty
EndProperty
End
Begin VB.CommandButton Command2
Caption = "查 询"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 3960
TabIndex = 6
Top = 180
Width = 1065
End
Begin VB.CommandButton Command1
Caption = "......."
Height = 405
Left = 3990
TabIndex = 5
Top = 660
Width = 855
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1170
TabIndex = 4
Top = 660
Width = 2745
End
Begin VB.ComboBox Combo1
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 780
Style = 2 'Dropdown List
TabIndex = 1
Top = 210
Width = 3150
End
Begin VB.Label Label3
Alignment = 2 'Center
BackColor = &H000000FF&
BorderStyle = 1 'Fixed Single
Caption = "等待操作......"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 345
Left = 120
TabIndex = 8
Top = 1110
Width = 3075
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "学员姓名"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 60
TabIndex = 3
Top = 720
Width = 1020
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "驾 校"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 2
Top = 240
Width = 645
End
End
End
Attribute VB_Name = "Form7"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ss(1 To 20) As String
Private Sub Combo2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command3.SetFocus
End Sub
Private Sub Combo3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Combo4.SetFocus
End Sub
Private Sub Combo4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text2(1).SetFocus
End Sub
Private Sub Command1_Click()
Adodc1.RecordSource = "select xm,zjhm,zt ,jdjx from xyb where zt=0 and jdjx='" & Trim(Combo1.Text) & "' and xm like'" & Trim(Text1.Text) & "%' order by bmsj"
Adodc1.Refresh
Label3.Caption = "有" & Adodc1.Recordset.RecordCount & "人"
End Sub
Private Sub Command2_Click()
Adodc1.RecordSource = "select xm,zjhm,zt ,jdjx from xyb where zt=0 and jdjx='" & Combo1.Text & "' order by bmsj"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
Label3.Caption = "有" & Adodc1.Recordset.RecordCount & "人"
End Sub
Private Sub Command3_Click()
On Error Resume Next
Dim XY As String
Dim YE As String
Dim i As Integer, j As Integer
Dim RS As New ADODB.Recordset
Dim Zh(1 To 10) As String
If Text2(0).Text = "" Then
MsgBox "提交失败，ID卡号码不能为空", 0 + vbCritical, "系统提示"
Exit Sub
End If
XY = ""
YE = "0"
For i = 0 To List1.ListCount
XY = XY & "','" & Mid(List1.List(i), 1, InStr(List1.List(i), " "))
Next
If XY <> "" Then XY = Mid(XY, 3) & "'"
For j = i To 14
XY = XY & ",''"
Next
YE = Str(List1.ListCount * 300)
If MsgBox("确实提交", 1 + 32, "系统提示") = vbOK Then
Err.Clear
Cn.Execute "INSERT IDYH VALUES('" & Trim(Text2(0).Text) & "','" & Trim(Text2(1).Text) & "','" & Combo4.Text & "','" & "99999" & "','" & Combo3.Text & "','" & Trim(Text2(2).Text) & "',0,'" & Trim(Text2(3).Text) & "','" & Trim(Combo2.Text) & "'," & XY & ",'" & format(Date, "yyyy-mm-dd") & "',0 )"
If Err.Number Then
MsgBox "提交失败，ID卡号码已存在", 0 + vbCritical, "系统提示"
Exit Sub
Else
MsgBox "提交成功", 0 + vbExclamation, "系统提示"
For i = 0 To 3
Text2(i).Text = ""
Next
Adodc2.RecordSource = "select * from idyh where jx='" & Combo4.Text & " ' order by kh"
Adodc2.Refresh
For i = 1 To List1.ListCount
Cn.Execute "update xyb set zt=-1 where zjhm='" & Trim(Mid(List1.List(i - 1), InStr(List1.List(i - 1), " "))) & "'"
Next
Command2_Click
List1.Clear
End If
End If
End Sub
Private Sub Command4_Click()
End Sub
Private Sub Command5_Click()
Adodc2.RecordSource = "select * from idyh where jx='" & Combo4.Text & " ' order by kh"
Adodc2.Refresh
End Sub
Private Sub Command6_Click()
Dim F As New FileSystemObject
Dim Xl As Object
Dim K As New Excel.Application
Dim RS As New ADODB.Recordset
Dim i As Integer, j As Integer
F.CopyFile App.Path & "\file\表格.xls", App.Path & "\tmp\表格" & format(Date, "YYYY_MM") & ".xls"
Set Xl = K.Workbooks.Open(App.Path & "\tmp\表格" & format(Date, "YYYY_MM") & ".xls")
RS.CursorLocation = adUseClient
RS.Open "select kh,xm,zh,cph,xy1,xy2,xy3,xy4,xy5,xy6,xy7,xy8,xy9,xy10,xy11,xy12,xy13,xy14,xy15,ye from idyh where jx='" & Combo4.Text & " ' order by kh", Cn, 1, 3
i = 5
j = 1
Do While Not RS.EOF
For j = 1 To 20
Xl.Worksheets(1).Cells(i, j).Value = RS(j - 1)
Next
i = i + 1
RS.MoveNext
Loop
RS.Close
If MsgBox("是否现在打开" & App.Path & "\file\工资" & format(Date, "YYYY_MM") & ".xls", 1 + vbExclamation, "系统提示") = vbOK Then
Xl.Application.Visible = True
Else
Xl.Application.Quit
End If
End Sub
Private Sub Command7_Click()
Dim RS As New ADODB.Recordset
Dim Ks As Double
RS.CursorLocation = adUseClient
RS.Open "select ye from idyh where jx='" & Combo4.Text & " '", Cn, 1, 3
Ks = 0
Do While Not RS.EOF
Ks = Ks + Val(RS("ye"))
RS.MoveNext
Loop
RS.Close
MsgBox Combo4.Text & " 学校的总卡时为： " & Ks, 0 + vbExclamation, "系统提示"
End Sub
Private Sub Command8_Click()
On Error Resume Next
DataGrid1.Col = 1
Dim Tj As String
Tj = "delete from xyb where zjhm='" & DataGrid1.Text & "'"
If MsgBox("确实删除", 1 + 32, "系统提示") = vbOK Then
Cn.Execute "INSERT RZ VALUES('" & Replace(Tj, "'", "") & "','" & Yh & "','" & format(Date, "YYYY-MM-DD") & " " & format(Time, "hh:nn:ss") & "')"
Cn.Execute "delete from xyb where zjhm='" & DataGrid1.Text & "'"
Command2_Click
End If
End Sub
Private Sub DataGrid1_DblClick()
On Error Resume Next
Dim s As String
Dim i As Integer
Dim kk As Boolean
kk = False
s = ""
DataGrid1.Col = 0
s = DataGrid1.Text
DataGrid1.Col = 1
s = s & String$(15 - Len(s), " ") & DataGrid1.Text
For i = 0 To List1.ListCount
If List1.List(i) = s Then kk = True: Exit For
Next
If Not kk Then List1.AddItem s
End Sub
Private Sub Form_Load()
Dim RS As New ADODB.Recordset
Me.Left = (MDIForm1.Width - Me.Width) / 2
Me.Top = (MDIForm1.Height - Me.Height) / 2 - 1000
Me.Show
RS.CursorLocation = adUseClient
RS.Open "select * from jx", Cn, 1, 3
Do While Not RS.EOF
Combo1.AddItem RS(0)
Combo4.AddItem RS(0)
RS.MoveNext
Loop
RS.Close
Combo2.Clear
Combo2.AddItem "兰色"
Combo2.AddItem "黄色"
Combo2.AddItem "白色"
Combo2.AddItem "其他"
Combo2.Text = "黄色"
RS.CursorLocation = adUseClient
RS.Open "select jb from jb", Cn, 1, 3
Do While Not RS.EOF
Combo3.AddItem RS(0)
RS.MoveNext
Loop
RS.Close
Adodc1.ConnectionString = Cn.ConnectionString
Adodc2.ConnectionString = Cn.ConnectionString
MSComm1.CommPort = Yj(5) '串口号，
MSComm1.Settings = "9600,N,8,1" '串口的属性
MSComm1.InputLen = 0 '接收缓冲区的大小
MSComm1.InputMode = comInputModeBinary '二进制接受方式
MSComm1.RThreshold = 7 '每7个字节响应消息
MSComm1.PortOpen = True '打开通信串口
End Sub
Private Sub List1_DblClick()
Dim s As String
Dim i As Integer, j As Integer, K As Integer
s = List1.Text
K = 1
For i = 1 To List1.ListCount
If s <> List1.List(i - 1) Then ss(K) = List1.List(i - 1): K = K + 1
Next
List1.Clear
For j = 1 To K - 1
List1.AddItem ss(j)
Next
End Sub
Private Sub MSComm1_OnComm()
Dim Buffer As Variant '存储数据的缓冲区
Dim CardNumber As Long '卡号
Select Case MSComm1.CommEvent '串口事件
Case comEvReceive '接收到数据
Buffer = MSComm1.Input '清理接收缓冲区，此时，接收的字节数已经为0
CardNumber = CDec(Buffer(4)) * 2 ^ 16 + (Buffer(5) * 2 ^ 8) + Buffer(6) '单个字节数据左移
Text2(0).Text = CardNumber
Combo3.SetFocus
End Select
End Sub
Private Sub Text1_Change()
If Text1.Text <> "" Then
Adodc1.RecordSource = "select xm,zjhm,zt ,jdjx from xyb where zt=0 and JDjx='" & Trim(Combo1.Text) & "' and xm like'" & Trim(Text1.Text) & "%' order by bmsj"
Adodc1.Refresh
Label3.Caption = "有" & Adodc1.Recordset.RecordCount & "人"
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Adodc1.Recordset.RecordCount = 1 Then DataGrid1_DblClick
End If
End Sub
Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 And Index = 1 Then Text2(2).SetFocus
If KeyAscii = 13 And Index = 2 Then Text2(3).SetFocus
If KeyAscii = 13 And Index = 3 Then Combo2.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -