?? 日記帳.frm
字號:
If CDate(edtRq) > zjLogInfo.curDate Then
Beep
MsgBox "記賬日期不能超出當前登錄日期，請檢查！", vbInformation, zjGl_Name
SetTxtFocus edtRq
Exit Function
End If
dDate = CDate(edtRq)
Frame1.Left = -10000
Frame2.Left = -30
Me.Refresh
Command1(0).Enabled = False
Command1(1).Enabled = False
IsValid = True
End Function
Private Sub Form_Load()
LoadStatic
CheckedPages
CenterForm Me
End Sub
Private Sub LoadStatic()
dSysStartDay = ZjAccInfo.zjStartdate
Me.Icon = LoadResPicture(109, vbResIcon)
edtRq = FormatDate(zjLogInfo.curDate)
cmdrq.Picture = LoadResPicture(1108, vbResBitmap)
End Sub
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%函數(shù)說明:日記賬進行的工作 %
'%參 數(shù): %
'%返回值 : %
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub BookPages()
' 將 FD_AccSum(總賬表) 中每一賬戶追補到今日
InitFD_Accsum
' 將已審核且未記賬單據(jù)作標記并歸集總賬
RezeroStatus "正在進行記賬工作...", "貸款單："
iNoField = 0
SendToFD_Accsum "FD_Cred", True 'FD_Cred, 貸款單
RezeroStatus "正在進行記賬工作...", "還款單："
iNoField = 0
SendToFD_Accsum "FD_Return", False 'FD_Return, 還款單
RezeroStatus "正在進行記賬工作...", "還息單："
iNoField = 0
SendToFD_Accsum "FD_CreAcrRcp", False 'FD_CreAcrRcp, 還息單
RezeroStatus "正在進行記賬工作...", "存款單："
iNoField = 0
SendToFD_Accsum "FD_Sav", True 'FD_Sav, 存款單
RezeroStatus "正在進行記賬工作...", "取款單："
iNoField = 0
SendToFD_Accsum "FD_Fetch", False 'FD_Fetch, 取款單
iNoField = 0
RezeroStatus "正在進行記賬工作...", "內(nèi)部拆借單："
SendUnwToFD_Accsum "FD_UnwDeb" 'FD_UnwDeb, 內(nèi)部拆借單
RezeroStatus "正在進行記賬工作...", "內(nèi)部拆借還款單："
iNoField = 0
SendUnwToFD_Accsum "FD_UnwRet" 'FD_UnwRet, 內(nèi)部拆借還款單
RezeroStatus "正在進行記賬工作...", "內(nèi)部拆借還息單："
iNoField = 0
SendUnwToFD_Accsum "FD_UnwAcrRcp" 'FD_UnwAcrRcp, 內(nèi)部拆借還息單
RezeroStatus "正在進行記賬工作...", "結(jié)算單："
iNoField = 0
SendJsToFD_Accsum "FD_SettAcc" 'FD_SettAcc, 結(jié)算單
RezeroStatus "正在進行記賬工作...", "利息單："
iNoField = 0
SendUnwToFD_Accsum "FD_CadAcr" 'FD_CadAcr, 利息單
' 對于資金賬戶的定額處理
ZjDeTreat
' 累積類賬戶,單據(jù)
' 判斷今天是否結(jié)息日（或最近一次結(jié)息日未計息），是：計息.
' 或最近一次結(jié)息日所有賬戶的積數(shù)是否=0，是：計息
RezeroStatus "正在進行利息計算，請稍等...", "賬戶："
iNoField = 0
EstimateCad
' 單據(jù)
' 判斷部分類型的單據(jù)是否到期（貸款單，定期存款單，內(nèi)部拆借單）
RezeroStatus "正在進行利息計算，請稍等...", "貸款單："
iNoField = 0
EstimateCadCred 'FD_Cred, 貸款單(結(jié)息日，到期日判斷)
' EstimateCadSav 'FD_Sav, 存款單
RezeroStatus "正在進行利息計算，請稍等...", "內(nèi)部拆借單："
iNoField = 0
EstimateCadUnw 'FD_UnwDeb, 內(nèi)部拆借單
RezeroStatus "正在進行預提利息計算，請稍等...", "定期存款單："
iNoField = 0
EstimateYtCadSav '定期存款 利息
' RezeroStatus "正在進行預提利息計算，請稍等...", "貸款單："
' iNoField = 0
' EstimateYtCadCred 'FD_Cred, 貸款單(結(jié)息日，到期日判斷)
End Sub
'*******************************************************************
'*函數(shù)說明:對內(nèi)部拆借單進行利息計算 *
'*參 數(shù): *
'*返回值 : *
'*******************************************************************
Private Sub EstimateCadUnw()
Dim sqlTable As String
Dim sqlCad As String
Dim rsTable As New UfRecordset
Dim rsCad As New UfRecordset
sqlTable = "SELECT * FROM FD_UnwDeb WHERE dret_date <= '" & FormatDate(CDate(dDate + 1)) & "' AND bsettle =0"
Set rsTable = dbsZJ.OpenRecordset(sqlTable, dbOpenDynaset)
If Not rsTable.EOF Then
rsTable.MoveLast
Me.ProgressBar1.Max = rsTable.RecordCount
rsTable.MoveFirst
End If
While Not rsTable.EOF
ChangeStatus Right(rsTable!cUnwID, 8), 1
sqlCad = "SELECT dbill_date FROM FD_CadAcr WHERE cDanID='" & rsTable!cUnwID & _
"' AND dTo >= '" & FormatDate(rsTable!Dret_date) & "'"
Set rsCad = dbsZJ.OpenRecordset(sqlCad, dbOpenDynaset)
If rsCad.EOF Then
' 計息
Nbcj_Lx rsTable, rsTable!Dret_date - 1, True
End If
rsTable.MoveNext
Wend
End Sub
'*******************************************************************
'*函數(shù)說明:對累積類賬戶進行利息計算 *
'*參 數(shù): *
'*返回值 : *
'*******************************************************************
Private Sub EstimateCad()
Dim sqlAccDef As String
Dim sqlAccSum As String
Dim sqlCadSets As String
Dim RsAccDef As New UfRecordset
Dim rsAccSum As New UfRecordset
Dim RsCadSets As New UfRecordset
Dim dTemp As Date
Dim dOpenDate As Date
sqlAccDef = "SELECT cAccID, cCadID FROM FD_AccDef WHERE bDestroy =0"
Set RsAccDef = dbsZJ.OpenRecordset(sqlAccDef, dbOpenSnapshot)
If Not RsAccDef.EOF Then
RsAccDef.MoveLast
Me.ProgressBar1.Max = RsAccDef.RecordCount
RsAccDef.MoveFirst
End If
While Not RsAccDef.EOF
ChangeStatus RsAccDef!cAccID, 1
'---- 得到開戶日期
dOpenDate = GetAccountOpenDate(RsAccDef!cAccID)
'---- 取出結(jié)息日信息
sqlCadSets = "SELECT dClosDate FROM FD_CadSets WHERE cCadID='" & RsAccDef!cCadID & "' ORDER BY dClosDate"
Set RsCadSets = dbsZJ.OpenRecordset(sqlCadSets, dbOpenSnapshot)
Do While Not RsCadSets.EOF
dTemp = RsCadSets!dClosDate
If dDate < dTemp Then Exit Do
If dOpenDate - 1 < dTemp Then '---- 開戶日期
sqlAccSum = "SELECT mh, mcdeh FROM FD_AccSum WHERE cAccID='" & RsAccDef!cAccID & _
"' AND dbill_date='" & FormatDate(dTemp) & "'"
Set rsAccSum = dbsZJ.OpenRecordset(sqlAccSum, dbOpenDynaset)
If Not rsAccSum.EOF Then
If rsAccSum!Mh <> 0 Or rsAccSum!Mcdeh <> 0 Then
' ** to AND
' 計息
Zw_Lx RsAccDef!cAccID, dTemp, True
End If
End If
End If
RsCadSets.MoveNext
Loop
RsAccDef.MoveNext
Wend
End Sub
Private Function GetAccountOpenDate(AccountID As String) As Date
Dim sqlAcc As String
Dim rsAcc As New UfRecordset
sqlAcc = "SELECT dOpenDate From FD_AccDef Where cAccID = '" & AccountID & "'"
Set rsAcc = dbsZJ.OpenRecordset(sqlAcc, dbOpenSnapshot)
GetAccountOpenDate = rsAcc!dOpenDate
CloseRS rsAcc
End Function
'*******************************************************************
'*函數(shù)說明:對貸款單進行利息計算 *
'*參 數(shù): *
'*返回值 : *
'*******************************************************************
Private Sub EstimateCadCred()
Dim sqlTable As String
Dim sqlCad As String
Dim sqlCadSets As String
Dim rsTable As New UfRecordset
Dim rsCad As New UfRecordset
Dim RsCadSets As New UfRecordset
Dim vRef As Variant
sqlTable = "SELECT * FROM FD_Cred WHERE bsettle =0"
Set rsTable = dbsZJ.OpenRecordset(sqlTable, dbOpenDynaset)
If Not rsTable.EOF Then
rsTable.MoveLast
Me.ProgressBar1.Max = rsTable.RecordCount
rsTable.MoveFirst
End If
Do While Not rsTable.EOF
ChangeStatus Right(rsTable!cCreID, 8), 1
If rsTable!Dret_date - 1 <= dDate Then
sqlCad = "SELECT dbill_date FROM FD_CadAcr WHERE cDanID='" & rsTable!cCreID & _
"' AND dTo >= '" & FormatDate(rsTable!Dret_date) & "'"
Set rsCad = dbsZJ.OpenRecordset(sqlCad, dbOpenSnapshot)
If rsCad.EOF Then
' 計息
vRef = PreLxdDate(Cred_Bill, "", rsTable!cCreID)
If IsNull(vRef) Then
vRef = rsTable!dbill_date
End If
Dk_Lx rsTable, rsTable!Dret_date - 1, True, vRef
End If
End If
'取出結(jié)息日信息
sqlCadSets = "SELECT dClosDate FROM FD_CadSets WHERE cCadID='" & rsTable!cCadID & "' ORDER BY dClosDate"
Set RsCadSets = dbsZJ.OpenRecordset(sqlCadSets, dbOpenSnapshot)
While Not RsCadSets.EOF
If dDate >= RsCadSets!dClosDate And RsCadSets!dClosDate >= rsTable!dbill_date And dDate >= rsTable!dbill_date Then
sqlCad = "SELECT dbill_date FROM FD_CadAcr WHERE cDanID='" & rsTable!cCreID & _
"' AND dTo >= '" & FormatDate(RsCadSets!dClosDate) & "'"
Set rsCad = dbsZJ.OpenRecordset(sqlCad, dbOpenDynaset)
If rsCad.EOF Then
' 計息
vRef = PreLxdDate(Cred_Bill, "", rsTable!cCreID)
If IsNull(vRef) Then
vRef = rsTable!dbill_date
End If
Dk_Lx rsTable, RsCadSets!dClosDate, True, vRef
End If
End If
RsCadSets.MoveNext
Wend
rsTable.MoveNext
Loop
End Sub
'cuidong YT.A 2001.10.21
'-------------------------------------
'函數(shù)說明:對貸款單進行利息計算
'參 數(shù):
'返回值 :
Private Sub EstimateYtCadCred()
Dim sqlTable As String
Dim sqlCad As String
Dim sqlCadSets As String
Dim rsTable As New UfRecordset
Dim rsCad As New UfRecordset
Dim RsCadSets As New UfRecordset
Dim vRef As Variant
Dim dFromDate As Date
sqlTable = "SELECT FD_AccDef.cAccID, FD_AccDef.iYt, FD_AccDef.cYtID, FD_Cred.cCreID, FD_Cred.dBill_Date, FD_Cred.cIntrID, FD_Cred.Dret_Date, FD_Cred.iArtyp FROM FD_Cred, FD_AccDef WHERE FD_Cred.cAccID = FD_AccDef.cAccID And FD_Cred.bsettle = 0 And (Not FD_AccDef.iYt = 0) And (Not FD_AccDef.cYtID Is Null) And (Not cBookCode Is Null) "
Set rsTable = dbsZJ.OpenRecordset(sqlTable, dbOpenDynaset)
If Not rsTable.EOF Then
rsTable.MoveLast
Me.ProgressBar1.Max = rsTable.RecordCount
rsTable.MoveFirst
End If
Do While Not rsTable.EOF
ChangeStatus Right(rsTable!cCreID, 8), 1
' If rsTable!Dret_date - 1 <= dDate Then
' sqlCad = "SELECT dbill_date FROM FD_CadAcr WHERE cDanID='" & rsTable!cCreID & _
' "' AND dTo >= '" & FormatDate(rsTable!Dret_date) & "'"
' Set rsCad = dbsZJ.OpenRecordset(sqlCad, dbOpenSnapshot)
' If rsCad.EOF Then
' ' 計息
' vRef = PreLxdDate(Cred_Bill, "", rsTable!cCreID)
' If IsNull(vRef) Then
' vRef = rsTable!dbill_date
' End If
' Dk_Lx rsTable, rsTable!Dret_date - 1, True, vRef
' End If
' End If
'取出結(jié)息日信息
sqlCadSets = "SELECT dClosDate FROM FD_CadSets WHERE cCadID='" & rsTable!cYtID & "' ORDER BY dClosDate"
Set RsCadSets = dbsZJ.OpenRecordset(sqlCadSets, dbOpenSnapshot)
While Not RsCadSets.EOF
If dDate >= RsCadSets!dClosDate And RsCadSets!dClosDate >= rsTable!dbill_date And dDate >= rsTable!dbill_date Then
dFromDate = rsTable!dbill_date
sqlCad = "SELECT dBill_date FROM FD_YtCadAcr WHERE cDanID='" & rsTable!cCreID & _
"' AND dBill_Date = '" & FormatDate(RsCadSets!dClosDate) & "'"
Set rsCad = dbsZJ.OpenRecordset(sqlCad, dbOpenDynaset)
If rsCad.EOF Then
' 計息
DK_YtLx rsTable, dFromDate, RsCadSets!dClosDate, True, vRef
End If
dFromDate = RsCadSets!dClosDate
End If
RsCadSets.MoveNext
Wend
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -