bos_mgtoaccbill_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_MgToAccBill_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"
Option Explicit

 
'定义 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
 
End Sub

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

End Sub
'************************************************************
'新增单据后，自动给代码付值
'************************************************************
Private Sub m_BillInterface_AfterNewBill()
    Dim sSql As String
    Dim rs As New ADODB.Recordset

    With m_BillInterface
        sSql = "select max(cast(FNumber as decimal)) as maxNum from t_EP_ER_AccToMgAcc "
        Set rs = .K3Lib.GetData(sSql)
        If rs.State = adStateOpen And rs.RecordCount > 0 Then
            .SetFieldValue "FNumber", CStr(CNulls(rs("maxNum"), 0)) + 1
        End If
        
    End With
    Set rs = Nothing
End Sub

'************************************************************
'在保存前判断是否是重复的会计科目在部门
'************************************************************
Private Sub m_BillInterface_BeforeSave(bCancel As Boolean)
    Dim iAccId As Long
    Dim iDepId As Long
    Dim sSql As String
    Dim rs As New ADODB.Recordset
    On Error GoTo ERR
    With m_BillInterface
        iAccId = .GetFieldValue("FAcctID")
        iDepId = .GetFieldValue("FDepID")
        sSql = "select count(*) as cun from t_EP_ER_AccToMgAccEntry1 where FAcctid=" & iAccId & " and FDepID= " & iDepId & " and fid<> " & .CurBillID
        Set rs = .K3Lib.GetData(sSql)
        If rs.State = adStateOpen And rs("cun") > 0 Then
            bCancel = True
            MsgBox "不能输入重复的会计科目和部门的组合！", vbOKOnly + vbInformation, HINTINFO
        End If
        
    End With
    
    Set rs = Nothing
    Exit Sub
ERR:
    Set rs = Nothing
    MsgBox ERR.Number & ERR.Description, vbOKOnly + vbExclamation, HINTINFO
End Sub


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 bret As Boolean
    Dim sErr As String
    If dct("FFieldName") = "FBudgetItemNum" Then
        bret = getMgInfo(m_BillInterface.GetFieldValue("FBudgetItemNum"), sErr)
        If bret = False Then MsgBox sErr, vbOKOnly + vbExclamation, HINTINFO
    End If
End Sub

Private Function getMgInfo(sBudGetItemNum As String, ByRef sErr As String) As Boolean
    Dim sSql As String
    Dim rs As New ADODB.Recordset
    With m_BillInterface

        sSql = "select * from t_MgAcct where FNumber='" & sBudGetItemNum & "'"
'        sSql = "CASE WHEN (ISNULL(t3.Fname,'')<>'') THEN t3.Fname +'-'+t2.fname+'-'+t1.Fname ELSE t2.fname+'-'+t1.Fname END    AS FDSP" & _
'               " ,T1.* from t_mgacct t1 " & _
'               " left join t_mgacct t2 on t2.Fmgacctid=t1.FParentid " & _
'               " left join t_mgacct t3 on t3.Fmgacctid=t2.FParentid " & _
'               " Where t1.fDetail = 1 " & _
'               " order by t1.fnumber  "
        Set rs = .K3Lib.GetData(sSql)
        If rs.State = adStateOpen And rs.RecordCount = 1 Then
            If rs("FDetail") <> True Then
                sErr = "您所选的预算科目不是明细科目！"
                GoTo ERR

            End If
'            .SetFieldValue "FBudgetItemNum", rs("FNumber")
            .SetFieldValue "FBudgetItem", rs("FMgAcctId")
            .SetFieldValue "FBudgetItemName", rs("FName")
            getMgInfo = True
        Else
            sErr = "没有您所输入的预算科目！"
            GoTo ERR
        End If
        
    End With
    Exit Function
ERR:
    getMgInfo = False
    m_BillInterface.SetFieldValue "FBudgetItemNum", ""
    m_BillInterface.SetFieldValue "FBudgetItem", ""
    m_BillInterface.SetFieldValue "FBudgetItemName", ""
    Set rs = Nothing
    Exit Function

End Function