?? kqmodule.bas
字號:
With aInnerShift(4)
.ID = GSHIFTMONEYID
.ShiftName = GSHIFTMONEYNAME
.Note = GSHIFTMONEYSTR
End With
Dim Rst As Recordset
Dim i As Integer
Dim Sql As String
Dim IsToDelete As Boolean
Dim isToAdd As Boolean
On Error GoTo ShiftErr
For i = 1 To UBound(aInnerShift)
With aInnerShift(i)
IsToDelete = False
isToAdd = True
Sql = "Select * from Shift where ID=" & .ID
Set Rst = gDataBase.OpenRecordset(Sql, dbOpenSnapshot)
If Rst.RecordCount > 0 Then
If Rst!ShiftName <> Trim(.ShiftName) Then
IsToDelete = True
Else
isToAdd = False
End If
End If
Rst.Close
Set Rst = Nothing
If IsToDelete Then
Sql = "delete * from Shift where ID=" & .ID
gDataBase.Execute Sql
End If
If isToAdd Then
Sql = "Insert into Shift (ID,ShiftName) values(" & .ID _
& ",'" & .ShiftName & "')"
gDataBase.Execute Sql
End If
End With
Next
Exit Sub
ShiftErr:
Err.Clear
MsgBox mMsg1, vbExclamation, gTitle
EndSystem
End Sub
Public Sub EndSystem()
If Not gDataBase Is Nothing Then
gDataBase.Close
Set gDataBase = Nothing
End If
Dim Fr As Form
For Each Fr In Forms
Unload Fr
Next
End Sub
Private Sub IniItem(t_table As String, aArray() As ItemStruc)
ReDim aArray(0)
aArray(0).ID = gMAXITEM
Dim Rst As Recordset
Dim i As Integer
Dim isSame As Boolean
On Error GoTo ErrHandle
Set Rst = gDataBase.OpenRecordset("select * from " _
& Trim(t_table) & " Where F_DelFlag=" & gFALSE _
& " order by ID", dbOpenSnapshot)
While Not Rst.EOF
isSame = False
For i = 0 To UBound(aArray)
If Rst!ID = aArray(i).ID Then
isSame = True
Exit For
End If
Next
If Not isSame Then
ReDim Preserve aArray(UBound(aArray) + 1)
With aArray(UBound(aArray))
.ID = Rst!ID
.Name = IIf(IsNull(Rst!Name), "", Trim(Rst!Name))
End With
End If
Rst.MoveNext
Wend
Rst.Close
Set Rst = Nothing
Exit Sub
ErrHandle:
Dim er As Error
Dim MsgStr As String
For Each er In Errors
MsgStr = MsgStr & er.Description & er.Number & vbCrLf
Next
MsgBox MsgStr, , gTitle
Resume Next
End Sub
Public Sub RefreshButton(cmdEdit As Object, Optional intActionAfter As Integer = gCMDEDITNORMAL)
Dim i As Integer
Select Case intActionAfter
Case gCMDAPPEND
For i = 0 To cmdEdit.Count - 2
With cmdEdit(i)
Select Case i
Case gCMDSAVE, gCMDRETURN, gCMDAPPEND
If Not .Enabled Then .Enabled = True
Case gCMDEDIT, gCMDDELETE, gCMDQUERY
If .Enabled Then .Enabled = False
End Select
End With
Next
Case gCMDEDITNORMAL
For i = 0 To cmdEdit.Count - 2
With cmdEdit(i)
Select Case i
Case gCMDAPPEND, gCMDQUERY, gCMDRETURN
If Not .Enabled Then .Enabled = True
Case gCMDSAVE, gCMDEDIT, gCMDDELETE
If .Enabled Then .Enabled = False
End Select
End With
Next
Case gCMDEDIT
For i = 0 To cmdEdit.Count - 2
With cmdEdit(i)
Select Case i
Case gCMDSAVE, gCMDEDIT
If Not .Enabled Then .Enabled = True
Case gCMDAPPEND, gCMDDELETE, gCMDQUERY, gCMDRETURN
If .Enabled Then .Enabled = False
End Select
End With
Next
Case gCMDEDITCANCEL
If cmdEdit(gCMDSAVE).Enabled Then cmdEdit(gCMDSAVE).Enabled = False
End Select
End Sub
Public Sub ChangeBackColor(cn As Control, isEdit As Boolean)
If isEdit Then
cn.BackColor = vbWhite
Else
cn.BackColor = &H8000000F
End If
End Sub
Public Sub ClipToGrid(msfGrid As MSFlexGrid, ClipStr As String, intRows As Integer, intCols As Integer)
With msfGrid
On Error GoTo ClipErr
.Rows = .FixedRows
If intRows > .FixedRows Then
If .Redraw Then .Redraw = False
.Rows = intRows
.Cols = intCols
.row = .FixedRows
.col = .FixedCols
.RowSel = .Rows - 1
.ColSel = .Cols - 1
.Clip = ClipStr
.row = .FixedRows
.col = 0
.Redraw = True
.RowHeightMin = 300
End If
End With
Exit Sub
ClipErr:
MsgBox Err.Description, vbExclamation, gTitle
Err.Clear
End Sub
Public Function HasThisTable(TableName As String) As Boolean
Dim TD As TableDef
For Each TD In gDataBase.TableDefs
If TD.Name = TableName Then
HasThisTable = True
Exit Function
End If
Next
HasThisTable = False
End Function
Public Function CreateAllRecord(TableName As String) As Boolean
Dim intEmp As Integer
Dim intDay As Integer
Dim Rst As Recordset
Dim strWorkNo As String
Dim bytDay As Byte
Dim bytShift As Byte
Dim Sql As String
bytShift = gNOSHIFT '缺省的 無班次
On Error GoTo CreateRecErr
Set Rst = gDataBase.OpenRecordset("select WorkNo from Employee" _
& " where F_DelFlag=" & gFALSE, dbOpenSnapshot)
While Not Rst.EOF
strWorkNo = Trim(Rst!WorkNo)
For intDay = 1 To gMaxDay
bytDay = intDay
Sql = "Insert into " & TableName & _
" (WorkNo,F_Day,F_Shift) values ('" _
& strWorkNo & "'," & bytDay & "," & bytShift & ")"
gDataBase.Execute Sql
Next
Rst.MoveNext
Wend
Rst.Close
Set Rst = Nothing
CreateAllRecord = True
Exit Function
CreateRecErr:
Err.Clear
CreateAllRecord = False
End Function
Public Function CreatePlanTable() As Boolean
Dim strTableName As String
Dim HasThisTD As Boolean
Dim HasRecord As Boolean
Dim TD As TableDef
Dim Rst As Recordset
strTableName = gPlanTableName
HasThisTD = HasThisTable(strTableName)
If Not HasThisTD Then '無此表
If Not CreateATable(strTableName) Then GoTo IniErr
End If
Set Rst = gDataBase.OpenRecordset(strTableName)
If Rst.RecordCount > 0 Then HasRecord = True
Rst.Close
Set Rst = Nothing
If Not HasRecord Then '無記錄
If Not CreateAllRecord(strTableName) Then GoTo IniErr
End If
CreatePlanTable = True
Exit Function
IniErr:
CreatePlanTable = False
Exit Function
End Function
Public Sub GetPosToCbo(tmpCbo As ComboBox)
Dim mSql As String
Dim mRst As Recordset
mSql = "select * from T_Pos order by PosNo"
Set mRst = gDataBase.OpenRecordset(mSql)
Dim Str As String
tmpCbo.Clear
While Not mRst.EOF
Str = IIf(IsNull(mRst!PosName), "", Trim(mRst!PosName))
tmpCbo.AddItem Str
tmpCbo.ItemData(tmpCbo.NewIndex) = mRst!PosNo
mRst.MoveNext
Wend
If tmpCbo.ListCount > 0 Then tmpCbo.ListIndex = 0
mRst.Close
Set mRst = Nothing
End Sub
Public Function IsNormalKq(IntShift As Integer, strWorkNo As String, strDate As String, strKqTime As String) As Boolean
Dim sKqTime As String
Dim tmpStr As String
Dim mSql As String
Dim mRst As Recordset
strKqTime = Empty
mSql = "select F_1On from Shift where ID=" & IntShift _
& " and F_1OnIsKq=" & gTRUE '暫時只適合A段要求考勤的班次
'只要在KqHistory中添加F_Section(是哪段考勤)
Set mRst = gDataBase.OpenRecordset(mSql, dbOpenSnapshot)
If mRst.RecordCount > 0 Then
sKqTime = IIf(IsNull(mRst!F_1On), "", Trim(mRst!F_1On))
Else
IsNormalKq = False
Exit Function
End If
mRst.Close
Set mRst = Nothing
If sKqTime = Empty Then
IsNormalKq = False
Exit Function
End If
mSql = "select KqTime from KqHistory " _
& " where KqDate='" & strDate & "'" _
& " and WorkNo='" & strWorkNo & "'" _
& " order by KqTime"
Set mRst = gDataBase.OpenRecordset(mSql, dbOpenSnapshot)
If mRst.RecordCount > 0 Then
tmpStr = IIf(IsNull(mRst!KqTime), "", Trim(mRst!KqTime))
End If
mRst.Close
Set mRst = Nothing
If tmpStr = Empty Then
IsNormalKq = False
'Exit Function
Else
If sKqTime < tmpStr Then
IsNormalKq = False
Else
IsNormalKq = True
End If
End If
strKqTime = tmpStr
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -