bos_wipe3bill_plugins.cls

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

                            
                '取预算范围，是月还是季还是年,没有的话，默认为季度预算
                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 = 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"))
                            
'                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 = Left(.GetFieldValue("FBillDate"), 4)
                iPeriod = Mid(.GetFieldValue("FBillDate"), 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("Page4").Item(i)(.DataSrv.TableInfo("map")("FID_SRC"))("FFLD")) <> "" Then
                    sFid_src = " AND t1.fid<> " & .Data("Page4").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_EP_ER_WipeOff3Entry3 t1 " & _
                        " INNER JOIN t_EP_ER_WipeOff3 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("page4").Size
                
                    If .Data("Page4").Item(j)(.DataSrv.TableInfo("map")("FWipeITEM"))("FFLD") = lAcctId _
                        And .Data("Page4").Item(j)(.DataSrv.TableInfo("map")("FDivideDep"))("FFLD") = lDepId Then
                        lUseAmt3 = lUseAmt3 + .Data("Page4").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) & "'，部门 ：'" & _
                        .GetFieldValue("FDivideDep", i, Enu_ValueType_FFND) & "-" & .GetFieldValue("FDivideDep", 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
    


Private Sub m_BillInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
        If BOSTool.ToolName = "mnuEditDelRow" Then
            If tmpFloanItem <> "" Then
                Cancel = True
                MsgBox "关联借款申请单的记录行不能删除！", vbOKOnly + vbInformation, HINTINFO
            End If
        End If
        If BOSTool.ToolName = "mnuCopyRow" Then
            If tmpFloanItem <> "" Then
                Cancel = True
                MsgBox "关联借款申请单的记录行不能复制！", vbOKOnly + vbInformation, HINTINFO
            End If
        End If
        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
Private Function getBudgetid() As Boolean
        '-------------------------------------------------------------------
        '新增单据后，取当前的预算方案编号
        '-------------------------------------------------------------------
        Dim rs As New ADODB.Recordset
    With m_BillInterface
        Set rs = .K3Lib.GetData("select FProjectID,FName from t_mgBudgetSet where fexec=1")
    
        If rs.State = adStateOpen And rs.RecordCount > 0 Then
            .SetFieldValue "FBudgetScheme", rs("FName")
            lBudgetProjectID = rs("FProjectID")
            getBudgetid = True
        Else
            MsgBox "当前没有正在执行的预算！", vbOKOnly + vbExclamation, HINTINFO
            lBudgetProjectID = 0
            getBudgetid = False
        End If
    End With
    Set rs = Nothing
End Function