bos_loanbill_plugins.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "BOS_LoanBill_PlugIns"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "This is BillEvent Interface Class, made by K3BOSPLUGINSWIZAED"
 
'定义 BillEvent 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillInterface  As BillEvent
Attribute m_BillInterface.VB_VarHelpID = -1


 
Public Sub Show(ByVal oBillInterface As Object)
    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = oBillInterface
    With m_BillInterface
        .BillHeads.Item(1).BOSFields("FLoanItem").Filter = "t_Account.FNumber like '4105%' or t_Account.FNumber like '55%' " 'ORDER BY substring(FNumber,1,1) desc"
    End With
End Sub

Private Sub Class_Terminate()
    '释放接口对象
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = Nothing

End Sub

Private Sub m_BillInterface_AfterLoadBill()
   '-------------------------------------------------------------------
   '1在借款方式为“支票,汇票，限额支票”时，显示　字段“限额” 锁定字段 “借款金额”
   '-------------------------------------------------------------------
   With m_BillInterface
        If .GetFieldValue("floantype", , Enu_ValueType_FFND) = "LOAN04" Then
            .ShowHideField .GetFieldInfoByKey("FMaxAmount", "", 0), True
            .LockCell .GetFieldInfoByKey("FAmount", "", 0), 0, True
             .SetFieldValue "FAmount", 0
        Else
            .ShowHideField .GetFieldInfoByKey("FMaxAmount", "", 0), False
            .LockCell .GetFieldInfoByKey("FAmount", "", 0), 0, False
            .SetFieldValue "FMaxAmount", 0
        End If
    End With
 
End Sub

Private Sub m_BillInterface_AfterNewBill()
    '-------------------------------------------------------------------
    '新增单据后，取当前的预算方案编号
    '-------------------------------------------------------------------
    Dim rs As New ADODB.Recordset
    Set rs = m_BillInterface.K3Lib.GetData("select FProjectID,FName from t_mgBudgetSet where fexec=1")

    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        m_BillInterface.SetFieldValue "FBudgetScheme", rs("FName")
        lBudgetProjectID = rs("FProjectID")
    Else
        MsgBox "当前没有正在执行的预算！", vbOKOnly + vbExclamation, HINTINFO
        lBudgetProjectID = 0
    End If
End Sub

Private Sub m_BillInterface_AfterSave(bCancel As Boolean)
'自动启动审核
    With m_BillInterface
        Dim bStatus As Boolean
        bStatus = .MultiCheckMgr.CheckStarted
        If bStatus = False Then bStatus = .MultiCheckMgr.MultiCheckBill(.Data("FID"))
    End With
End Sub


'**********************************************************************
'保存单据前，判断
'1 有没有当前执行预算
'2 金额和限额只可有一个有值 ,同时将有效值放入借款金额字段中
'3 在会计科目与预算科目的对应表中是否存在这个会计科目＋部门
'4 判断当前金额有没有超过预算金额
'**********************************************************************
Private Sub m_BillInterface_BeforeSave(bCancel As Boolean)

    Dim rs As New ADODB.Recordset
    '-------------------------------------------------------------------
    '1 有没有当前执行预算
    '-------------------------------------------------------------------
    Set rs = m_BillInterface.K3Lib.GetData("select FProjectID,FName from t_mgBudgetSet where fexec=1")

    If rs.State = adStateOpen And rs.RecordCount > 0 Then
        m_BillInterface.SetFieldValue "FBudgetScheme", rs("FName")
        lBudgetProjectID = rs("FProjectID")
    Else
        MsgBox "当前没有正在执行的预算,不能申请借款！", vbOKOnly + vbInformation, HINTINFO
        bCancel = True
        Exit Sub
    End If
    '-------------------------------------------------------------------
    '2 金额和限额只可有一个有值
    '-------------------------------------------------------------------
    If m_BillInterface.GetFieldValue("FAmount") = 0 And m_BillInterface.GetFieldValue("FMaxAmount") = 0 Then
        MsgBox "请填写借款金额或限额！", vbOKOnly + vbInformation, HINTINFO
        bCancel = True
        Exit Sub
    Else
        '将金额或限额的值放到借款金额中去，做为控制字段
        If m_BillInterface.GetFieldValue("FAmount") <> 0 Then
            m_BillInterface.SetFieldValue "FCtlAmt", m_BillInterface.GetFieldValue("FAmount")
        Else
            m_BillInterface.SetFieldValue "FCtlAmt", m_BillInterface.GetFieldValue("FMaxAmount")
        End If

    End If

    '-------------------------------------------------------------------
    '4 判断当前金额有没有超过预算金额
    '-------------------------------------------------------------------
    Dim bret As Boolean
    Dim lBalanceAmt As Currency, sRet As String
    bret = compareNum(lBalanceAmt, sRet)
    If bret = False Then
        MsgBox sRet, vbOKOnly + vbInformation, HINTINFO
        bCancel = True
    Else
        m_BillInterface.SetFieldValue "FBudgetAmt", lBalanceAmt
    End If
    
    Set rs = Nothing

End Sub

'**********************************************************************
'值更改时：
'1在借款方式为“支票”时，显示　字段“限额”
'2 '在借款方式为“支票”时，字段“限额”，“金额”只能录入一个
        '同时将它转换为大写
'4'在申请部门和借款项目都不为空时，显示预算余额
'**********************************************************************
Private Sub m_BillInterface_Change(ByVal dct As KFO.IDictionary, ByVal dctFld As KFO.IDictionary, ByVal Col As Long, ByVal Row As Long, Cancel As Boolean)
    Dim FAmt
    Dim FMaxAmt
    Dim bret As Boolean, sRet As String, lBalanceAmt As Currency
    With m_BillInterface
        '-------------------------------------------------------------------
        '1在借款方式为“支票,汇票，限额支票”时，显示　字段“限额” 锁定字段 “借款金额”
        '-------------------------------------------------------------------
        If dct("FFieldName") = "FLoanType" Then
            If .GetFieldValue("floantype", , Enu_ValueType_FFND) = "LOAN04" Then
                .ShowHideField .GetFieldInfoByKey("FMaxAmount", "", 0), True
                .LockCell .GetFieldInfoByKey("FAmount", "", 0), 0, True
                .SetFieldValue "FAmount", 0
            Else
                .ShowHideField .GetFieldInfoByKey("FMaxAmount", "", 0), False
                .LockCell .GetFieldInfoByKey("FAmount", "", 0), 0, False
                .SetFieldValue "FMaxAmount", 0
            End If
        End If
        '-------------------------------------------------------------------
        '2在借款方式为“支票,汇票，限额支票”时，字段“限额”，“金额”只能录入一个
        '同时将它转换为大写
        '-------------------------------------------------------------------
        If dct("FFieldName") = "FAmount" Or dct("FFieldName") = "FMaxAmount" Then
            If .GetFieldValue("FAmount") <> 0 And .GetFieldValue("FMaxAmount") <> 0 Then
                .SetFieldValue dct("FFieldName"), 0
                MsgBox "限额和金额只能填写一个值！", vbOKOnly + vbInformation, HINTINFO
                Exit Sub
            End If
            
            '转换为大写
            .SetFieldValue "FCapitalAmt", PricetoChinese(.GetFieldValue(dct("FFieldName")))
            
        End If

        '-------------------------------------------------------------------
        '3在申请部门和借款项目都不为空时，显示预算余额
        '-------------------------------------------------------------------
        
        If dct("FFieldName") = "FReqDept" Or dct("FFieldName") = "FLoanItem" Then
            If .GetFieldValue("FReqDept") <> "" And .GetFieldValue("FLoanItem") <> "" Then
                bret = compareNum(lBalanceAmt, sRet, 1)
                If bret Then
                    .SetFieldValue "FBudgetAmt", lBalanceAmt
                Else
                    .SetFieldValue "FBudgetAmt", 0
                    MsgBox sRet, vbOKOnly + vbInformation, HINTINFO
                End If
            End If
            
        End If
        
        
    End With
End Sub
'*********************************************************************
'判断
'该会计科目和部门是否在中间表中存在
'*********************************************************************
Private Function isExist(iAccId As Long, iDepId As Long) As Boolean
    Dim sSql As String
    Dim rs As New ADODB.Recordset
    
    With m_BillInterface
        sSql = " select count(*) as cun from t_EP_ER_AccToMgAccEntry1 where FAcctid=" & iAccId & " and FDepID= " & iDepId
        Set rs = .K3Lib.GetData(sSql)
        If rs.State = adStateOpen And rs("cun") = 0 Then
            isExist = False
        Else
            isExist = True
        End If
    End With

    Set rs = Nothing
End Function
'*********************************************************************
'判断
'3 判断当前金额有没有超过预算金额
'*********************************************************************
Private Function compareNum(ByRef lBalanceAmt As Currency, ByRef sRet As String, Optional iType As Integer) As Boolean

  Dim lAmt As Currency  '借款金额
  Dim lbudget As Currency '预算金额
  Dim lUseAmt As Currency '已用预处金额
  Dim lUseAmt1 As Currency
  Dim lUseAmt2 As Currency
  Dim lUseAmt21 As Currency
  Dim lUseAmt22 As Currency
  Dim lUseAmt23 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 i As Integer
  Dim sSql As String
  
  On Error GoTo ERR
  With m_BillInterface
    '取借款金额的值
    If iType = 1 Then
        lAmt = 0
    Else
        
        lAmt = CNulls(m_BillInterface.GetFieldValue("FCtlAmt"), 0)
    End If
    '取对应预算方案
    lbudgetID = lBudgetProjectID
    
    '对应部门，
    lDepId = .GetFieldValue("FReqDept")
    
    '会计科目