bos_loanbill_plugins.cls

完成报销系统的业务流程；在报销系统中达到预算控制目的；将历史数据导入金蝶账套生成历史备查数据。

    lAcctId = .GetFieldValue("FLoanItem")
    
    '2根据财务科目内码取预算科目的内码 lBudgetAcc

    sSql = "select FBudgetItem from t_EP_ER_AccToMgAccEntry1 t1  " & _
                    " inner join t_EP_ER_AccToMgAcc t2 on t1.fid=t2.fid " & _
                    " where FAcctID = '" & lAcctId & "' and FDepID  ='" & lDepId & "'"
     Set rs = .K3Lib.GetData(sSql)
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        lBudgetAccId = rs("FBudgetItem")
    Else
        '没有对应的预算科目
        sErr = sErr & "您录入的　“会计科目”：" & _
           CStr(.GetFieldValue("FLoanItem", , Enu_ValueType_FFND)) & "-" & CStr(.GetFieldValue("FLoanItem", , Enu_ValueType_FDSP)) & _
            " 和 “部门”" & CStr(.GetFieldValue("FReqDept", , Enu_ValueType_FFND)) & "-" & CStr(.GetFieldValue("FReqDept", , Enu_ValueType_FDSP)) & _
            "　没有对应预算科目！"
        compareNum = False
        sRet = sErr
        Exit Function
    End If

    If rs.State = adStateOpen Then rs.Close
    
    '取预算范围，是月还是季还是年,没有的话，默认为季度预算
    Set rs = .K3Lib.GetData("select FValue from T_SystemProfile where FCategory='mg' and FKey='BudGet_Con'")
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        lBudgetCon = rs("FValue")
    Else
        lBudgetCon = 4
    End If
    
    If rs.State = adStateOpen Then rs.Close
    
    '取该部门的该科目在预算期间的的预算总和
    Dim iYear As Integer
    Dim iPeriod As Integer
    
    iYear = Left(.GetFieldValue("FBillDate"), 4)
    iPeriod = Mid(.GetFieldValue("FBillDate"), 6, 2)
    
'    iYear = Left(.K3Lib.GetData("select  convert(varchar(19),getdate(),21)  as date")("Date"), 4)
'    iPeriod = Mid(.K3Lib.GetData("select  convert(varchar(19),getdate(),21) as date")("Date"), 6, 2)

'    iYear = CInt(.K3Lib.GetData("select FValue from t_systemprofile where FCategory='GL' and FKey='CurrentYear'")("FValue"))
'    iPeriod = CInt(.K3Lib.GetData("select FValue from t_systemprofile where FCategory='GL' and FKey='CurrentPeriod'")("FValue"))
        
            Select Case lBudgetCon '０本期预算　１累计预算 ２本年预算 ３方案预算  ４季度预算 ５半年预算
                Case 0
                    sConBound = "FYear= " & iYear & " and FPeriod <=" & iPeriod
                    sConBound1 = " substring(convert(varchar(7),FBillDate,21),1,4)='" & CStr(iYear) & "' and substring(convert(varchar(7),FBillDate,21),6,2)<='" & CStr(iPeriod) & "'"
                Case 1
                Case 2
                    sConBound = "FYear= " & iYear
                    sConBound1 = " substring(convert(varchar(7),FBillDate,21),1,4)= '" & CStr(iYear) & "'"
                Case 3
                Case 4
                    If iPeriod <= 3 Then
                        sConBound = "FYear= " & iYear & " and FPeriod<=3 " ' in (1,2,3)"
                        sConBound1 = " substring(convert(varchar(7),FBillDate,21),1,4)='" & CStr(iYear) & "' and substring(convert(varchar(7),FBillDate,21),6,2)<='03'"
                    ElseIf iPeriod >= 4 And iPeriod <= 6 Then
                        sConBound = "FYear= " & iYear & " and FPeriod <=6 " 'in (4,5,6)"
                        sConBound1 = " substring(convert(varchar(7),FBillDate,21),1,4)='" & CStr(iYear) & "' and substring(convert(varchar(7),FBillDate,21),6,2)<='06'"
                    ElseIf iPeriod >= 7 And iPeriod <= 9 Then
                        sConBound = "FYear= " & iYear & " and FPeriod <=9 " 'in (7,8,9)"
                        sConBound1 = " substring(convert(varchar(7),FBillDate,21),1,4)='" & CStr(iYear) & "' and substring(convert(varchar(7),FBillDate,21),6,2)<='09'"
                    ElseIf iPeriod >= 10 And iPeriod <= 12 Then
                        sConBound = "FYear= " & iYear & " and FPeriod <=12 " 'in (10,11,12)"
                        sConBound1 = " substring(convert(varchar(7),FBillDate,21),1,4)='" & CStr(iYear) & "' and substring(convert(varchar(7),FBillDate,21),6,2)<='12'"
                    End If
                    
                Case 5
                    If iPeriod < 7 Then
                        sConBound = "FYear= " & iYear & " and FPeriod <=6" 'in (1,2,3,4,5,6)"
                        sConBound1 = " substring(convert(varchar(7),FBillDate,21),1,4)='" & CStr(iYear) & "' and substring(convert(varchar(7),FBillDate,21),6,2)<='06'"
                    ElseIf iPeriod >= 7 Then
                        sConBound = "FYear= " & iYear & " and FPeriod <=12" ' in (7,8,9,10,11,12)"
                        sConBound1 = " substring(convert(varchar(7),FBillDate,21),1,4)='" & CStr(iYear) & "' and substring(convert(varchar(7),FBillDate,21),6,2)<='12'"
                    End If
            End Select
      '本年的到目前为止的预算
    sSql = "SELECT sum(case when Acct.FDC=1 then isnull(Budd.FDebitMoney,0) else IsNull(Budd.FCreditMoney,0) end) as FBudMoney" & _
            " FROM t_MgBudGetDetail As BudD" & _
            " Inner join t_MgBudGet as Bud on Bud.FBudGetID= Budd.FBudgetID" & _
            " Inner join t_MgBudgetSet As BudSet On Bud.FProjectID=BudSet.FProjectID" & _
            " Inner Join t_MgAcct as Acct ON  Acct.FMgAcctID=Bud.FMgAcctID" & _
            " Where BudSet.FExec = 1 And Bud.FItemID = 0 And Acct.FDelete = 0 And Bud.FCyID = 1" & _
            " And   Acct.FMgAcctID = '" & lBudgetAccId & "'"
    sSql = sSql & " and " & sConBound
    Set rs = .K3Lib.GetData(sSql)
    
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        lbudget = CNulls(rs("FBudMoney"), 0)
    Else
        lbudget = 0
    End If
    If rs.State = adStateOpen Then rs.Close
'    '本年计算调整金额
'    sSql = "SELECT isnull(sum(case when Acct.FDC=1 then isnull(BudModD.FDebitMoney,0) else IsNull(BudModD.FCreditMoney,0) end),0)  as FBudMoney " & _
'            " FROM t_MgBudModifyDetail As BudModD" & _
'            " Inner join t_MgBudGetModify as BudMod on BudMod.FModifyid= BudModD.FModifyid" & _
'            " inner join T_MgBudGet as Bud on Bud.FBudGetID =BudMod.FBudGetID" & _
'            " Inner join t_MgBudgetSet As BudSet On Bud.FProjectID=BudSet.FProjectID" & _
'            " Inner Join t_MgAcct as Acct ON  Acct.FMgAcctID=Bud.FMgAcctID" & _
'            " Where BudSet.FExec = 1 And Bud.FItemID = 0 And Acct.FDelete = 0 And Bud.FCyID = 1" & _
'            " And  Acct.FMgAcctID = '" & lBudgetAccId & "'"
'    sSql = sSql & " and " & sConBound
'    Set rs = .K3Lib.GetData(sSql)
'    If rs.State = adStateOpen And rs.RecordCount > 0 Then
'        lbudget = lbudget + CCur(CNulls(rs("FBudMoney"), 0))
'    Else
'        lbudget = 0
'    End If
'    If rs.State = adStateOpen Then rs.Close
    
    '计算预算科目的已经用金额－本年
    '取对应预算科目所对应的全部 --会计科目
    sSql = "select * from t_EP_ER_AccToMgAccEntry1 t1  " & _
                    " inner join t_EP_ER_AccToMgAcc t2 on t1.fid=t2.fid " & _
                    " where FBudgetItem ='" & lBudgetAccId & "'"
     Set rs = .K3Lib.GetData(sSql)
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        i = 1
        sAccIdDepId = ""
        rs.MoveFirst
        While i <= rs.RecordCount
            If sAccIdDepId = "" Then
                sAccIdDepId = sAccIdDepId & " (FReqDept= '" & CStr(rs("FDepID")) & "' and FLoanItem='" & CStr(rs("FAcctID")) & "')"
            Else
                sAccIdDepId = sAccIdDepId & " or " & " (FReqDept= '" & CStr(rs("FDepID")) & "' and FLoanItem='" & CStr(rs("FAcctID")) & "')"
            End If
            i = i + 1
            rs.MoveNext
        Wend
    Else

    End If
    
    '1. 借款申请的金额，只取没有与报销单勾销的
     sSql = " select isnull(sum(FCtlAmt),0)   as FCtlAmt from t_EP_ER_Loan t1 " & _
    " LEFT JOIN T_ITEM T2 ON T2.FItemClassid=2 and t1.FReqDept=t2.fitemid  " & _
    " where Fclose=0  " & _
     " and  " & sConBound1 & " and t1.Fid <> " & .CurBillID
     If sAccIdDepId <> "" Then sSql = sSql & " AND (" & sAccIdDepId & ")"
     
    Set rs = .K3Lib.GetData(sSql)
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        lUseAmt1 = CNulls(rs("FCtlAmt"), 0)
    Else
        lUseAmt1 = 0
    End If
    If rs.State = adStateOpen Then rs.Close
    '2.　报销的金额
    sSql = "select ISNULL(sum(t1.FWipeAmt),0) as FWipeAmt from t_EP_ER_WipeOff1Entry1 t1 " & _
            " INNER JOIN t_EP_ER_WipeOff1 t2 on t1.Fid=t2.Fid " & _
            " AND " & sConBound1 & " AND (( T1.FID_src <> " & .CurBillID & " and FClassid_src='110000200') or  (T1.FID_src = 0 and FClassid_src=0))"
    If sAccIdDepId <> "" Then
        sAccIdDepId = Replace(sAccIdDepId, "FReqDept", "FDivideDep")
        sAccIdDepId = Replace(sAccIdDepId, "FLoanItem", "FWipeItem")
        sSql = sSql & " AND (" & sAccIdDepId & ")"
    End If
    Set rs = .K3Lib.GetData(sSql)
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        lUseAmt21 = CNulls(rs("FWipeAmt"), 0)
    Else
        lUseAmt21 = 0
    End If
    If rs.State = adStateOpen Then rs.Close
    '支出证明单中的金额
    sSql = "select ISNULL(sum(t1.FWipeAmt),0) as FWipeAmt from t_EP_ER_WipeOff2Entry1 t1 " & _
            " INNER JOIN t_EP_ER_WipeOff2 t2 on t1.Fid=t2.Fid " & _
            " AND " & sConBound1 & " AND ((T1.FID_SRC <> " & .CurBillID & " and FClassid_src='110000200') or  (T1.FID_src = 0 and FClassid_src=0))"
    If sAccIdDepId <> "" Then
        sAccIdDepId = Replace(sAccIdDepId, "FReqDept", "FDivideDep")
        sAccIdDepId = Replace(sAccIdDepId, "FLoanItem", "FWipeItem")
        sSql = sSql & " AND (" & sAccIdDepId & ")"
    End If
    Set rs = .K3Lib.GetData(sSql)
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        lUseAmt22 = CNulls(rs("FWipeAmt"), 0)
    Else
        lUseAmt22 = 0
    End If
    If rs.State = adStateOpen Then rs.Close
    '差旅费报销的金额
    sSql = "select ISNULL(sum(t1.FWipeAmt),0) as FWipeAmt from t_EP_ER_WipeOff3Entry3 t1 " & _
            " INNER JOIN t_EP_ER_WipeOff3 t2 on t1.Fid=t2.Fid " & _
            " AND " & sConBound1 & "AND ((T1.FID_SRC <> " & .CurBillID & " and FClassid_src='110000200') or  (T1.FID_src = 0 and FClassid_src=0))"
    If sAccIdDepId <> "" Then
        sAccIdDepId = Replace(sAccIdDepId, "FReqDept", "FDivideDep")
        sAccIdDepId = Replace(sAccIdDepId, "FLoanItem", "FWipeItem")
        sSql = sSql & " AND (" & sAccIdDepId & ")"
    End If
    Set rs = .K3Lib.GetData(sSql)
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        lUseAmt23 = CNulls(rs("FWipeAmt"), 0)
    Else
        lUseAmt23 = 0
    End If
    If rs.State = adStateOpen Then rs.Close
    '借款金额　加上报销金额　加上本次借款金额
    Dim tmpfUserAmt As Currency
    If .GetFieldValue("FClose") = 1 Then
        tmpfUserAmt = .GetFieldValue("FWipeOffAmt")
    ElseIf (Trim(.GetFieldValue("FClose") = "") Or .GetFieldValue("FClose") = 0) And iType = 0 Then
        tmpfUserAmt = .GetFieldValue("FCtlAmt")

    End If

    If iType = 0 Then
        lUseAmt = lUseAmt1 + lUseAmt21 + lUseAmt22 + lUseAmt23 + tmpfUserAmt
    Else
        lUseAmt = lUseAmt1 + lUseAmt21 + lUseAmt22 + lUseAmt23
    End If

    '判断余额是否大于借款金额
    If lbudget >= lUseAmt Then
'       lBalanceAmt = lbudget - lUseAmt
        lBalanceAmt = lbudget - lUseAmt1 - lUseAmt21 - lUseAmt22 - lUseAmt23
        compareNum = True
    Else
        compareNum = False
        lBalanceAmt = lbudget - lUseAmt1 - lUseAmt21 - lUseAmt22 - lUseAmt23
        sRet = sRet & "借款项目： '" & .GetFieldValue("FLOANItem", , Enu_ValueType_FFND) & "-" & .GetFieldValue("FLOANItem", , Enu_ValueType_FDSP) & "',预算余额：" & CStr(lBalanceAmt) & "，当前借款金额：" & CStr(.GetFieldValue("FCtlAmt")) & "已经超过预算金额！" & vbCrLf
    End If
    
    End With
    Set rs = Nothing
    Exit Function
ERR:
    Set rs = Nothing
    compareNum = False
    sRet = "比较预算余额失败，原因：" & sRet & ERR.Number & ERR.Description
End Function
   
Private Function getLoanItem() As String
    Dim rs As New ADODB.Recordset
    
    Set rs = m_BillInterface.K3Lib.GetData(" SELECT FMgAcctid,FNumber+" & "' - '" & "+FName as FDS   FROM t_MgAcct WHERE  FTradeID=0 order by FNumber")
    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        rs.MoveFirst
        While Not rs.EOF
            If getLoanItem <> "" Then getLoanItem = getLoanItem & ","
            getLoanItem = getLoanItem & CNulls(rs("FMgAcctid"), "") & "=" & CNulls(rs("FDS"), "")
            rs.MoveNext
        Wend
    End If
    
    Set rs = Nothing
End Function

Private Sub m_BillInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    With m_BillInterface
        If BOSTool.ToolName = "mnuFilePreview" Or BOSTool.ToolName = "mnuFilePrint" Then
             If .BillStatus = Enu_BillStatusExt_New Then
                MsgBox "请先保存单据，再进行打印操作！", vbOKOnly + vbInformation, HINTINFO
                Cancel = True
            End If
        End If

    End With
End Sub