bos_wipebill_plugins.cls

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

     '-------------------------------------------------------------------
    '判断
    '3 判断当前金额有没有超过预算金额
    '-------------------------------------------------------------------
    Dim lAmt As Currency  '借款金额
    Dim lbudget As Currency '预算金额
    Dim lUseAmt As Currency '已用预处金额
    Dim lUseAmt1 As Currency
    Dim lUseAmt2 As Currency
    Dim lUseAmt3 As Currency
    Dim lbudgetID As Long  '预算方案ＩＤ
    Dim lDepId As Long  '部门ＩＤ
    Dim lDetailId As Long
    Dim lAcctId As Long '会计科目
    Dim lBudgetAccId As Long  '预算科目
    Dim sAccIdDepId As String '预算科目对应会计科目和部门　和字符串
    Dim lBudgetCon As Long '预算控制　０本期预算　１累计预算 ２本年预算 ３方案预算  ４季度预算 ５半年预算
    Dim sConBound As String '预算控制范围的字符串
    Dim sConBound1 As String
    Dim rs As New ADODB.Recordset
    Dim sSql As String
    Dim iYear As Integer
    Dim iPeriod As Integer
    Dim i As Integer, j As Integer
    Dim sFid_src As String '源单编号
    Dim sErr As String
    
    
    On Error GoTo ERR
    With m_BillInterface
         '取对应预算方案
        lbudgetID = lBudgetProjectID
        
        '循环分录中的所有列
        i = 1
beg:        While i <= .Data("Page2").Size
                '对应部门，
                lDepId = .Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FDivideDep"))("FFLD")
                
                '取借款金额的值
                If iType = 1 Then
                    lAmt = 0
                Else
                    lAmt = .Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FloanAmt"))("FFLD")
                End If
    
                '会计科目--报销科目＝借款科目（如果有借款存在）
                lAcctId = .Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FWipeItem"))("FFLD")

    
                '2根据财务科目内码取预算科目的内码 lBudgetAccId
                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(i) & "列中的　“会计科目”：" & _
                       CStr(.Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FWipeItem"))("FFND")) & "-" & CStr(.Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FWipeItem"))("FDSP")) & _
                        " 和 “部门”" & .Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FDivideDep"))("FFND") & "-" & .Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FDivideDep"))("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
                       
                '3 根据预算类型进行条件拼写
                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)
                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
                    j = 1
                    sAccIdDepId = ""
                    rs.MoveFirst
                    While j <= 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
                        j = j + 1
                        rs.MoveNext
                    Wend
                Else
            
                End If
                '1. 借款申请的金额，只取没有与报销单勾销的
                sFid_src = ""
                If Trim(.Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FID_SRC"))("FFLD")) <> "" Then
                    sFid_src = " AND t1.fid= " & .Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FID_SRC"))("FFLD")
                End If
                 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 & sFid_src
                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_BOSWipeOffEntry1 t1 " & _
                        " INNER JOIN t_BOSWipeOff t2 on t1.Fid=t2.Fid " & _
                        " AND " & sConBound1 & " AND T2.FID <> " & .CurBillID
                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
                    lUseAmt2 = CNulls(rs("FWipeAmt"), 0)
                Else
                    lUseAmt2 = 0
                End If
                If rs.State = adStateOpen Then rs.Close
                
                '3计算本次的该项目的报销金额　.Data("Page2").Item(i)(.DataSrv.TableInfo("map")("FWipeAmt"))("FFLD")
                lUseAmt3 = 0
                For j = 1 To .Data("page2").Size
                
                    If .Data("Page2").Item(j)(.DataSrv.TableInfo("map")("FWipeITEM"))("FFLD") = lAcctId _
                        And .Data("Page2").Item(j)(.DataSrv.TableInfo("map")("FDivideDep"))("FFLD") = lDepId Then
                        lUseAmt3 = lUseAmt3 + .Data("Page2").Item(j)(.DataSrv.TableInfo("map")("FWipeAmt"))("FFLD")
                    End If
                Next j
                '借款金额　加上报销金额　加上本次报销金额
                If iType <> 1 Then
                    lUseAmt = lUseAmt1 + lUseAmt2 + lUseAmt3
                Else
                    lUseAmt = lUseAmt1 + lUseAmt2
                End If
                '判断余额是否大于借款金额
                If lbudget < lUseAmt Then
                    '计算余额
                    lBalanceAmt = lbudget - lUseAmt1 - lUseAmt2
                    sErr = sErr & "报销项目： '" & .GetFieldValue("FWipeItem", i, Enu_ValueType_FFND) & "-" & .GetFieldValue("FWipeItem", i, Enu_ValueType_FDSP) & "',预算余额：" & lBalanceAmt & "，当前报销金额：" & lUseAmt3 & "已经超过预算金额！" & vbCrLf
                End If
                i = i + 1
       Wend
        If sErr <> "" Then
            compareNum = False
            sRet = sErr
        Else
            compareNum = True
        End If
       
    End With
    Set rs = Nothing
    Exit Function
ERR:
    Set rs = Nothing
    compareNum = False
    lBalanceAmt = 0
    sErr = ERR.Number & ERR.Description
    End Function