?? frmattendance.frm
字號:
Caption = "學生上下學信息"
BeginProperty Font
Name = "隸書"
Size = 24
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 615
Left = 2160
TabIndex = 0
Top = 360
Width = 5655
End
End
Attribute VB_Name = "FrmAttendance"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private ilate As Integer '遲到次數
Private iearly As Integer '早退次數
Private aflag As String '出入標志
Private addflag As Boolean '添加標志
Private firstID As String '第一個學生編號
Private Sub ASID_KeyDown(KeyCode As Integer, Shift As Integer)
TabToEnter KeyCode
End Sub
Private Sub ASID_LostFocus()
Dim SQL As String
Dim rs As New ADODB.Recordset
SQL = "select SName from StuffInfo where SID='" & Me.ASID.Text & "'"
Set rs = TransactSQL(SQL)
If rs.EOF = False Then
Me.ASName = rs(0) '初始化學生姓名
Else
MsgBox "學生編號輸入錯誤，或者沒有這個學生！", vbOKOnly + vbExclamation, "警告！"
Me.ASID = ""
Me.ASID.SetFocus
Me.ASID.ListIndex = 0
End If
rs.Close
End Sub
Private Sub cmdCancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub CheckRecord() '判斷是否存在記錄
Dim SQL As String
Dim rs As New ADODB.Recordset
SQL = "select * from AttendanceInfo where AStuffID='" & Me.ASID.Text & "'"
SQL = SQL & " and AFlag='" & aflag & "' and ADate=#" & Me.NowDate & "#"
Set rs = TransactSQL(SQL)
If rs.EOF = False Then
MsgBox "已經存在這條記錄！", vbOKOnly + vbExclamation, "警告！"
addflag = True
Else
addflag = False
End If
rs.Close
End Sub
Private Sub in_add() '添加上學記錄
Dim SQL As String
Dim rs As New ADODB.Recordset
SQL = "select * from AttendanceInfo"
Set rs = TransactSQL(SQL)
rs.AddNew
rs.Fields(1) = Me.ASID
rs.Fields(2) = Me.ASName
rs.Fields(3) = Me.NowDate
rs.Fields(4) = aflag
rs.Fields(5) = Me.InTime
rs.Fields(7) = ilate
rs.Update
rs.Close
End Sub
Private Sub out_add() '添加放學記錄
Dim SQL As String
Dim rs As New ADODB.Recordset
SQL = "select * from AttendanceInfo"
Set rs = TransactSQL(SQL)
rs.AddNew
rs.Fields(1) = Me.ASID
rs.Fields(2) = Me.ASName
rs.Fields(3) = Me.NowDate
rs.Fields(4) = aflag
rs.Fields(6) = Me.OutTime
rs.Fields(8) = iearly
rs.Update
rs.Close
End Sub
Private Sub cmdOK_Click()
Dim SQL As String
Dim sql2 As String
Dim rs As New ADODB.Recordset
Dim rsTime As New ADODB.Recordset
sql2 = "select * from AttendanceInfo order by ID desc"
SQL = "select * from TimeSetting"
Set rsTime = TransactSQL(SQL)
If flag = 1 Then
ilate = 0
iearly = 0
If Me.InFlag = False And Me.OutFlag = False Then
MsgBox "請選擇上下學！", vbOKOnly + vbExclamation, "警告！"
Else
If Me.InFlag = True Then '添加上學記錄
aflag = "入"
If Me.InTime = "" Or IsDate(Me.InTime) = False Then
MsgBox "請輸入正確的時間！", vbOKOnly + vbExclamation, "警告!"
Me.InTime = ""
Me.InTime.SetFocus
Else
If DateDiff("s", Me.InTime, rsTime(0)) < 0 Then
ilate = 1
End If
Call CheckRecord
If addflag = False Then
Call in_add
MsgBox "已經添加上學記錄！", vbOKOnly + vbExclamation, "添加結果！"
Call init
Me.InFlag = False
Else
Call init
Me.InFlag = False
End If
End If
End If
If Me.OutFlag = True Then '添加放學記錄
aflag = "出"
If Me.OutTime = "" Or IsDate(Me.OutTime) = False Then
MsgBox "請輸入正確的時間！", vbOKOnly + vbExclamation, "警告!"
Me.OutTime = ""
Me.OutTime.SetFocus
Else
If DateDiff("s", Me.OutTime, rsTime(1)) > 0 Then
iearly = 1
End If
Call CheckRecord
If addflag = False Then
Call out_add
MsgBox "已經添加放學記錄！", vbOKOnly + vbExclamation, "添加結果！"
Call init
Me.OutFlag = False
Else
Call init
Me.OutFlag = False
End If
End If
End If
End If
Call frmAResult.ListTopic
Call frmAResult.ShowData(sql2)
frmAResult.Show
frmAResult.ZOrder 0
Me.ZOrder 0
Else '修改記錄
If MsgBox("確定修改編號為" & Me.ASID & "的學生信息?", vbOKCancel, "提示！") _
= vbOK Then
If Me.InFlag = True Then
If DateDiff("s", Me.InTime, rsTime(0)) < 0 Then
ilate = 1
End If
SQL = "update AttendanceInfo set AInTime=#" & Me.InTime & "#,"
SQL = SQL & "ALate=" & ilate & " where ID=" & ArecordID
TransactSQL (SQL) '修改上學記錄
Call frmAResult.ListTopic
Call frmAResult.ShowData(sql2)
frmAResult.Show
MsgBox "信息已經修改！", vbOKOnly + vbExclamation, "修改結果！"
Unload Me
ElseIf Me.OutFlag = True Then
If DateDiff("s", Me.OutTime, rsTime(1)) > 0 Then
iearly = 1
End If
SQL = "update AttendanceInfo set AOutTime=#" & Me.OutTime & "#,"
SQL = SQL & "AEarly=" & iearly & " where ID=" & ArecordID
TransactSQL (SQL) '修改放學記錄
Call frmAResult.ListTopic
Call frmAResult.ShowData(sql2)
frmAResult.Show
MsgBox "信息已經修改！", vbOKOnly + vbExclamation, "修改結果！"
Unload Me
End If
Else
Unload Me
End If
End If
rsTime.Close
End Sub
Private Sub Form_Load()
Dim SQL As String
Dim rs As New ADODB.Recordset
If flag = 1 Then
SQL = "select SID from StuffInfo order by SID"
Set rs = TransactSQL(SQL)
If rs.EOF = False Then
rs.MoveFirst
firstID = rs(0)
While Not rs.EOF
Me.ASID.AddItem rs(0) '初始化學生編號
rs.MoveNext
Wend
rs.Close
Else
MsgBox "目前沒有學生！", vbOKOnly + vbExclamation, "警告！"
End If
Me.NowDate = Date
Me.ASID.ListIndex = 0
SQL = "select SName from StuffInfo where SID='" & firstID & "'"
Set rs = TransactSQL(SQL)
Me.ASName = rs(0) '初始化學生姓名
rs.Close
Me.OutTime = ""
Me.InTime = ""
ElseIf flag = 2 Then
Set rs = TransactSQL(kqsql)
'If rs.EOF = False And rs.BOF Then
If rs.EOF = False Then
rs.MoveFirst
firstID = rs(0)
With rs
Me.ASID = rs(1)
Me.ASName = rs(2)
Me.NowDate = rs(3)
If IsNull(rs(5)) = True Then
Me.InTime = ""
Me.OutFlag = True
Else
Me.InTime = rs(5)
End If
If IsNull(rs(6)) = True Then
Me.OutTime = ""
Me.InFlag = True
Else
Me.OutTime = rs(6)
End If
End With
rs.Close
End If
End If
End Sub
Private Sub init() '初始化
Dim SQL As String
Dim rs As New ADODB.Recordset
SQL = "select SName from StuffInfo where SID='" & firstID & "'"
Set rs = TransactSQL(SQL)
Me.ASID.ListIndex = 0
Me.ASName = rs(0)
Me.InTime = ""
Me.OutTime = ""
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -