日记帐.frm

用友u8财务源码,用visual basic开发

   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

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%函数说明:日记账进行的工作                                         %
'%参    数:                                                       %
'%返回值  :                                                        %
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Private Sub BookPages()
   ' 将 FD_AccSum(总账表) 中每一账户追补到今日
   InitFD_Accsum
   
   ' 将已审核且未记账单据作标记并归集总账
   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 "正在进行记账工作...", "内部拆借单："
   SendUnwToFD_Accsum "FD_UnwDeb"       'FD_UnwDeb,     内部拆借单
   
   RezeroStatus "正在进行记账工作...", "内部拆借还款单："
   iNoField = 0
   SendUnwToFD_Accsum "FD_UnwRet"       'FD_UnwRet,     内部拆借还款单
   
   RezeroStatus "正在进行记账工作...", "内部拆借还息单："
   iNoField = 0
   SendUnwToFD_Accsum "FD_UnwAcrRcp"       'FD_UnwAcrRcp,  内部拆借还息单
   
   RezeroStatus "正在进行记账工作...", "结算单："
   iNoField = 0
   SendJsToFD_Accsum "FD_SettAcc"       'FD_SettAcc,    结算单
   
   RezeroStatus "正在进行记账工作...", "利息单："
   iNoField = 0
   SendUnwToFD_Accsum "FD_CadAcr"       'FD_CadAcr,    利息单
   
   ' 对于资金账户的定额处理
   ZjDeTreat
   
   ' 累积类账户,单据
   ' 判断今天是否结息日（或最近一次结息日未计息），是：计息.
   ' 或最近一次结息日所有账户的积数是否=0，是：计息
   RezeroStatus "正在进行利息计算，请稍等...", "账户："
   iNoField = 0
   EstimateCad
   
   ' 单据
   ' 判断部分类型的单据是否到期（贷款单，定期存款单，内部拆借单）
   RezeroStatus "正在进行利息计算，请稍等...", "贷款单："
   iNoField = 0
   EstimateCadCred     'FD_Cred,       贷款单(结息日，到期日判断)

'   EstimateCadSav      'FD_Sav,        存款单
   
   RezeroStatus "正在进行利息计算，请稍等...", "内部拆借单："
   iNoField = 0
   EstimateCadUnw      'FD_UnwDeb,     内部拆借单
   
   RezeroStatus "正在进行预提利息计算，请稍等...", "定期存款单："
   iNoField = 0
   EstimateYtCadSav  '定期存款 利息
   
'   RezeroStatus "正在进行预提利息计算，请稍等...", "贷款单："
'   iNoField = 0
'   EstimateYtCadCred     'FD_Cred,       贷款单(结息日，到期日判断)
   
End Sub

'*******************************************************************
'*函数说明:对内部拆借单进行利息计算                                  *
'*参    数:                                                        *
'*返回值  :                                                        *
'*******************************************************************
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

'*******************************************************************
'*函数说明:对累积类账户进行利息计算                                  *
'*参    数:                                                        *
'*返回值  :                                                        *
'*******************************************************************
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)
      
      '---- 取出结息日信息
      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

'*******************************************************************
'*函数说明:对贷款单进行利息计算                                     *
'*参    数:                                                        *
'*返回值  :                                                        *
'*******************************************************************
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
      '取出结息日信息
      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
'-------------------------------------
'函数说明:对贷款单进行利息计算
'参    数:
'返回值  :
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
      '取出结息日信息
      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