?? formb0.frm
字號:
Private Sub Form_Load()
Db_fN2 = App.Path & StrDir & Db_Name2
StrCrq = Format(Date, "yyyy.mm.dd")
If myF_ConnT(Db_fN2) = False Then Unload Me: Exit Sub ' 連接庫 T ' 打開數據庫 2
StrT1 = "T_tm" ' 條目表 MyRs1
StrT2 = "T_zm" ' 賬目表 MyRs2
StrT3 = "T_yf" ' 報銷表 MyRs3
Rq = StrCrq
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End Sub
Private Sub Form_Activate()
If blnTc = True Then Unload Me: Exit Sub
Call P_grd1 ' T_yf 表
Call P_yftj ' 搜索條件
Call P_cmb1 ' 姓名
Call P_grd2 ' T_zm 表
Call P_init
intRo1 = 1
intRo2 = 1
intRo3 = 1
End Sub
Private Sub P_yftj() ' 醫藥費搜索條件
StrSQL = "Select * From " & StrT1 & _
" Where Dm Like 'Lb%' And (Jc Like 's' Or Jc Like 'z')" & _
" Order By Xh"
Set MyRs0 = New Recordset
MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
N5 = MyRs0.RecordCount:
If N5 > 0 Then
ReDim arrSl(N5, 2)
strYf = ""
For i = 1 To N5
If MyRs0![Mc] Like "*醫藥*" Then
If MyRs0![Jc] = "z" Then
strYd = " Where Sz='z' And Lb='" & MyRs0![Bz] & "' And Bh=0"
End If
If strYf = "" Then
strYf = strYf & "Sz='" & MyRs0![Jc] & "' And Lb='" & MyRs0![Bz] & "'"
Else
strYf = strYf & " Or Sz='" & MyRs0![Jc] & "' And Lb='" & MyRs0![Bz] & "'"
End If
End If
MyRs0.MoveNext
Next
strYf = " Where (" & strYf & ")": strTj = strYf
MyRs0.Close
Else
MsgBox " 沒有發現醫藥費類別信息 ... ", 48, " 請注意"
strTj = ""
End If
End Sub
Private Sub P_cmb1() ' 姓名 Combo1
strDm = "Xm"
StrSQL = "Select * From " & StrT1 & " Where Dm Like '" & strDm & "%' Order By Xh"
Set MyRs0 = New Recordset
MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
N0 = MyRs0.RecordCount
If N0 > 0 Then
N0 = MyRs0.RecordCount: ReDim arrXm(N0, 2)
With Combo1
.Clear
.AddItem " "
For i = 1 To N0
.AddItem " " & MyRs0![Mc]
arrXm(i, 1) = MyRs0![dm]
arrXm(i, 2) = MyRs0![Mc]
MyRs0.MoveNext
Next
End With
MyRs0.Close
End If
End Sub
Private Sub P_init()
strFs = "0"
For i = 0 To 3
Text1(i) = "": Text1(i).Enabled = False
Next
Label3 = "備注："
Combo1.Text = ""
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command7.Enabled = False
End Sub
Private Sub P_grd1()
Set MyRs3 = New Recordset ' T_yf 表
StrSQL = "SELECT * FROM " & StrT3 & " Order By Bh Desc"
MyRs3.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
N3 = MyRs3.RecordCount ' N3: 條數
ReDim arrBh(N3 + 10, 3)
If N3 = 0 Then
Bh = 0 ' T_yf( Bh,Xm,Sj,Je,Sl,Bx,Rq,Bz)
Else
Bh = MyRs3![Bh] ' 最后的編號
End If
With MSFlexGrid1
.Clear
.Rows = IIf(N3 + 2 < intRs1, intRs1, N3 + 2) + 1
.Cols = 8
.Height = 225 * (intRs1 + 1) + 90
.Row = 0: .Col = 0: .Text = "編號": .ColWidth(0) = 500
.Col = 1: .Text = " 姓 名 ": .ColWidth(1) = 1050
.Col = 2: .Text = " 起 止 時 間": .ColWidth(2) = 2250
.Col = 3: .Text = " 金 額 ": .ColWidth(3) = 980
.Col = 4: .Text = " 單據 ": .ColWidth(4) = 640
.Col = 5: .Text = " 報銷 ": .ColWidth(5) = 640
.Col = 6: .Text = " 報銷日期 ": .ColWidth(6) = 1160
.Col = 7: .Text = " 備 注": .ColWidth(7) = 1160 - IIf(.Rows > intRs1 + 1, 270, 0)
If N3 > 0 Then
MyRs3.MoveFirst
Jep = 0: Dsp = 0
For i = 1 To N3
arrBh(i, 0) = MyRs3![Bh]
arrBh(i, 1) = MyRs3![Bx]
arrBh(i, 2) = MyRs3![Rq]
Rq = MyRs3![Rq]
.TextMatrix(i, 0) = MyRs3![Bh] & " "
.TextMatrix(i, 1) = " " & MyRs3![Xm]
.TextMatrix(i, 2) = " " & MyRs3![Sj]
.TextMatrix(i, 3) = Format(MyRs3![Je], "0.00 ")
.TextMatrix(i, 4) = MyRs3![Sl] & " "
.TextMatrix(i, 5) = IIf(MyRs3![Bx] = "B", " √", "")
.TextMatrix(i, 6) = " " & MyRs3![Rq]
.TextMatrix(i, 7) = " " & MyRs3![Bz]
Jep = Jep + MyRs3![Je]
Dsp = Dsp + MyRs3![Sl]
MyRs3.MoveNext
Next
.TextMatrix(i + 1, 1) = " 累計"
.TextMatrix(i + 1, 3) = Format(Jep, "0.00 ")
.TextMatrix(i + 1, 4) = Dsp & " "
End If
' .MergeCol(1) = True
' .MergeCells = flexMergeRestrictColumns ' 單元格合并
.Visible = True
End With
End Sub
Private Sub P_grd2() ' 顯示 T_zm 表
Set MyRs2 = New Recordset
StrSQL = "SELECT * FROM " & StrT2 & strTj & " Order By Bh Desc,Rq Desc,Xh Desc"
MyRs2.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
N2 = MyRs2.RecordCount ' n2: 條數
With MSFlexGrid2
.Clear
.Top = MSFlexGrid1.Top + MSFlexGrid1.Height + 400
.Rows = IIf(N2 + 2 < intRs2, intRs2, N2 + 2) + 1
.Cols = 9
.Height = 225 * (intRs2 + 1) + 90
.Row = 0: .Col = 0: .Text = "序號": .ColWidth(0) = 500
.Col = 1: .Text = "編號": .ColWidth(1) = 500
.Col = 2: .Text = " 日期": .ColWidth(2) = 1150
.Col = 3: .Text = " 名 稱": .ColWidth(3) = 1690
.Col = 4: .Text = " 單價 ": .ColWidth(4) = 860
.Col = 5: .Text = "數量": .ColWidth(5) = 560
.Col = 6: .Text = " 收 入 ": .ColWidth(6) = 980
.Col = 7: .Text = " 支 出 ": .ColWidth(7) = 980
.Col = 8: .Text = " 備 注": .ColWidth(8) = 1160 - IIf(.Rows > intRs2 + 1, 270, 0)
If N2 > 0 Then
ReDim arrZm(N2, 3)
MyRs2.MoveFirst
Srp = 0: Zcp = 0
Bhp = 0: m = 1
For i = 1 To N2
Rq = MyRs2![Rq]
Sz = MyRs2![Sz]
arrZm(i, 0) = MyRs2![Xh] ' 暫存記錄
arrZm(i, 1) = MyRs2![Sz]
arrZm(i, 2) = MyRs2![Lb]
arrZm(i, 3) = MyRs2![Rq]
If Bhp = MyRs2![Bh] Then
If m = 2 Then
.Row = i
For j = 1 To .Cols - 1
.Col = j: .CellBackColor = intCx2 ' 設置顏色
Next
End If
Else
Bhp = MyRs2![Bh]
m = IIf(m = 1, 2, 1)
If m = 2 Then
.Row = i
For j = 1 To .Cols - 1
.Col = j: .CellBackColor = intCx2 ' 設置顏色
Next
End If
End If
.TextMatrix(i, 0) = i & " "
.TextMatrix(i, 1) = MyRs2![Bh] & " "
.TextMatrix(i, 2) = " " & Rq
.TextMatrix(i, 3) = " " & MyRs2![Mc]
.TextMatrix(i, 4) = IIf(MyRs2![Dj] > 0, Format(MyRs2![Dj], "0.00 "), "")
.TextMatrix(i, 5) = IIf(MyRs2![Sl] > 0, MyRs2![Sl] & " ", "")
.TextMatrix(i, 6) = IIf(Sz = "s", Format(MyRs2![Sr], "0.00 "), "")
.TextMatrix(i, 7) = IIf(Sz = "z", Format(MyRs2![Zc], "0.00 "), "")
.TextMatrix(i, 8) = " " & MyRs2![Bz]
Srp = Srp + MyRs2![Sr]
Zcp = Zcp + MyRs2![Zc]
MyRs2.MoveNext
Next
.TextMatrix(i + 1, 2) = " 累計"
.TextMatrix(i + 1, 6) = IIf(Srp > 0, Format(Srp, "0.00 "), "")
.TextMatrix(i + 1, 7) = Format(Zcp, "0.00 ")
Else
MsgBox " 很抱歉，暫無相關記錄 ... ", 48, " 請注意"
End If
.MergeCol(1) = True
.MergeCells = flexMergeRestrictColumns ' 單元格合并
.Visible = True
End With
End Sub
Private Sub MSFlexGrid2_Click() ' 匯總報銷單
If strFs <> "3" Then Exit Sub
With MSFlexGrid2
'MsgBox .TextMatrix(.Row, 1)
If Trim(.TextMatrix(.Row, 1)) = "" Then Exit Sub
If Val(.TextMatrix(.Row, 1)) > 0 Then Exit Sub
If Trim(.TextMatrix(.Row, 7)) = "" Then Exit Sub
.Col = 1
If .TextMatrix(.Row, 8) Like "*√*" Then
.TextMatrix(.Row, 8) = ""
For j = 1 To .Cols - 1
.Col = j: .CellBackColor = intCy2 ' 顏色復原
Next
Text1(0) = " " & Val(Text1(0)) - 1
Text1(1) = " " & Format(Val(Text1(1)) - Val(.TextMatrix(.Row, 7)), "0.00")
Else
.TextMatrix(.Row, 8) = " √"
For j = 1 To .Cols - 1
.Col = j: .CellBackColor = intCx2 ' 設置顏色
Next
Text1(0) = " " & Val(Text1(0)) + 1
Text1(1) = " " & Format(Val(Text1(1)) + Val(.TextMatrix(.Row, 7)), "0.00")
End If
Command1.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
End With
End Sub
Private Sub Combo1_Click() ' 選中一人
strFs = "3"
dm = arrXm(Combo1.ListIndex, 1) ' 代碼 Dm
Xm = arrXm(Combo1.ListIndex, 2)
If Xm = "" Then
strTj = strYf ' 全部
Else
strTj = strYf & " And Mc Like '%" & Xm & "%'"
End If
Call P_grd2
Command4.Enabled = True
Command5.Enabled = False
Call P_qtxt
Text1(2).Enabled = True
Text1(3).Enabled = True
End Sub
Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer) ' 選中一筆報銷單
If KeyAscii = 13 Then Call MSFlexGrid1_Click
End Sub
Private Sub MSFlexGrid1_Click() ' 選中一單
With MSFlexGrid1
If .Row > N3 Then Exit Sub
strFs = "2"
k = .Row
Bhp = arrBh(k, 0)
Bxp = arrBh(k, 1)
Xmp = Trim(.TextMatrix(k, 1))
Sjp = Trim(.TextMatrix(k, 2))
Jep = Trim(.TextMatrix(k, 3))
Combo1.Text = " " & Xmp
.Row = intRo1
For j = 1 To .Cols - 1
.Col = j: .CellBackColor = intCy1 ' 顏色復原
Next
intRo1 = k
.Row = k
For j = 1 To .Cols - 1
.Col = j: .CellBackColor = intCx1 ' 設置顏色
Next
Text1(0) = " " & Trim(.TextMatrix(k, 4))
Text1(1) = " " & Trim(.TextMatrix(k, 3))
Text1(2) = " " & Trim(.TextMatrix(k, 6))
Text1(3) = " " & IIf(.TextMatrix(k, 5) Like "*√*", Trim(.TextMatrix(k, 7)), StrCrq)
Label3 = "返款日期："
Command2.Enabled = False
Command4.Enabled = True
Command5.Enabled = True
Command7.Enabled = IIf(Trim(.TextMatrix(k, 5)) = "", True, False)
strTj = strYf & " And Bh=" & Bhp & " And Mc Like '%" & Xmp & "%'"
Call P_grd2
Label4 = IIf(Bxp = "B", "已報銷返款", "已匯總送交") & "的醫藥費單據："
Command3.Enabled = False
If Trim(.TextMatrix(k, 5)) = "" Then
strTj = strYd & " And Bh=0 And Mc Like '%" & Xmp & "%'"
m = 0: Call P_grd3
End If
End With
End Sub
Private Sub P_grd3()
Set MyRs0 = New Recordset ' T_zm 表
StrSQL = "SELECT * FROM " & StrT2 & strTj & _
" Order By Rq Desc,Xh Desc"
'MsgBox StrSQL
MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
N0 = MyRs0.RecordCount ' n0: 條數
If N0 < 1 Then
Exit Sub
End If
With MSFlexGrid2
.Height = 225 * (intRs1 + 1) + 90
.ColWidth(8) = 1160 - IIf(.Rows > intRs1 + 1, 270, 0)
End With
With MSFlexGrid3
.Clear
.Rows = IIf(N0 + 2 < intRs3, intRs3, N0 + 2) + 1
.Cols = 8
.Height = 225 * (intRs3 + 1) + 90
.Row = 0: .Col = 0: .Text = "序號": .ColWidth(0) = 500
.Col = 1: .Text = " 日期": .ColWidth(1) = 1150
.Col = 2: .Text = " 名 稱": .ColWidth(2) = 2130
.Col = 3: .Text = " 單價 ": .ColWidth(3) = 860
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -