⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 bos_billpayapply.cls

📁 金蝶地磅称重插件
💻 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_BillPayApply"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''票据付款申请单据插件
''建立日期:2005-08-19
''建立人:倪树祥
'''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'定义 BillEvent 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillInterface  As BillEvent
Attribute m_BillInterface.VB_VarHelpID = -1
'定义 ListEvents 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_ListInterface  As ListEvents
Attribute m_ListInterface.VB_VarHelpID = -1

Public Sub Show(ByVal oBosInterface As Object)
    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Select Case VBA.TypeName(oBosInterface)
        Case "BillEvent"
            Set m_BillInterface = oBosInterface     '单据
        Case "ListEvents"
            Set m_ListInterface = oBosInterface     '序时薄
    End Select
End Sub

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

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
    ''选单完成后
    On Error GoTo Errhandle
    '回写单据头金额合计字段
    Dim S_Key As String
    Dim L_Index As Long
    m_BillInterface.SetFieldValue "FAmountFor", m_BillInterface.Sum(m_BillInterface.GetFieldInfoByKey("FApplyAmountFor", S_Key, L_Index))
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
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)
    ''单据字段值改变时触发该事件
    On Error GoTo Errhandle
    '回写单据头金额合计字段
    If UCase(dct.Value("Ffieldname")) = UCase("FApplyAmountFor") Then
        Dim S_Key As String
        Dim L_Index As Long
        m_BillInterface.SetFieldValue "FAmountFor", m_BillInterface.Sum(m_BillInterface.GetFieldInfoByKey("FApplyAmountFor", S_Key, L_Index))
    End If
    Exit Sub
Errhandle:
    MsgBox err.Description, vbCritical, "金蝶提示"
End Sub

Private Sub m_BillInterface_MultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, bSendCheckMessage As Boolean, bSendAcceptMessage As Boolean, sMessageTitle As String, sMessage As String, Cancel As Boolean)
     UpdateChecker 1, lCheckLevel
End Sub

Private Sub m_BillInterface_UnMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, ByVal lLastCheckFrom As Long, ByVal lLastCheckTo As Long, bSendMessage As Boolean, Cancel As Boolean)
    UpdateChecker 2, lLastCheckTo
End Sub

Private Sub m_ListInterface_MultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckLevel As Long, ByVal lCheckStatus As Long, bSendCheckMessage As Boolean, bSendAcceptMessage As Boolean, sMessageTitle As String, sMessage As String, Cancel As Boolean)
    UpdateChecker 11, lCheckLevel
End Sub

Private Sub m_ListInterface_UnMultiCheck(ByVal lCheckMode As Long, ByVal lCheckMaxLevel As Long, ByVal lBusinessLevel As Long, ByVal lCheckStatus As Long, ByVal lLastCheckFrom As Long, ByVal lLastCheckTo As Long, bSendMessage As Boolean, Cancel As Boolean)
    UpdateChecker 12, lLastCheckTo
End Sub

Private Sub UpdateChecker(ByVal iCheckType As Integer, lCheckLevel As Long)
'iCheckType = 1:单据审核,2:单据反审,11:序时簿审核,12:序时簿反审。
    Dim strSql As String
    Dim strCondi As String
    Dim dctCurrRow As Dictionary
    
    If lCheckLevel <= 0 Then Exit Sub
    
    Select Case iCheckType
        Case 1 '单据审核
            strSql = m_BillInterface.K3Lib.User.UserName
            strCondi = " where FBillID = " & m_BillInterface.CurBillID
        Case 2 '单据反审
            strSql = ""
            strCondi = " where FBillID = " & m_BillInterface.CurBillID
        Case 11 '序时簿审核
            strSql = m_ListInterface.K3Lib.User.UserName
            Set dctCurrRow = m_ListInterface.GetCurrentSelRowInfo()
            strCondi = "where FBillID = " & dctCurrRow.GetValue("FBillID")
        Case 12 '序时簿反审
            strSql = ""
            Set dctCurrRow = m_ListInterface.GetCurrentSelRowInfo()
            strCondi = "where FBillID = " & dctCurrRow.GetValue("FBillID")
    End Select
      
    Select Case lCheckLevel
        Case 1 '采购综合业务科长
            Select Case iCheckType
                Case 1, 2 '1:单据审核,2:单据反审
                    m_BillInterface.SetFieldValue "FDeptChecker", strSql
                    strSql = "update t_BosRpPayApplyBill set FDeptChecker = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_BosRpPayApplyBill set FDeptChecker = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
            
        Case 2 '采购部长
            Select Case iCheckType
                Case 1, 2 '1:单据审核,2:单据反审
                    m_BillInterface.SetFieldValue "FMainChecker", strSql
                    strSql = "update t_BosRpPayApplyBill set FMainChecker = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_BosRpPayApplyBill set FMainChecker = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
        Case 3 '主管经理
            Select Case iCheckType
                Case 1, 2 '1:单据审核,2:单据反审
                    m_BillInterface.SetFieldValue "FSubChairman", strSql
                    strSql = "update t_BosRpPayApplyBill set FSubChairman = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_BosRpPayApplyBill set FSubChairman = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
        Case 4 '总经理
            Select Case iCheckType
                Case 1, 2 '1:单据审核,2:单据反审
                    m_BillInterface.SetFieldValue "FChairman", strSql
                    strSql = "update t_BosRpPayApplyBill set FChairman = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_BosRpPayApplyBill set FChairman = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
        Case 5 '财务核帐
            Select Case iCheckType
                Case 1, 2 '1:单据审核,2:单据反审
                    m_BillInterface.SetFieldValue "FCountChecker", strSql
                    strSql = "update t_BosRpPayApplyBill set FCountChecker = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_BosRpPayApplyBill set FCountChecker = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
        Case 6 '财务付款
            Select Case iCheckType
                Case 1, 2 '1:单据审核,2:单据反审
                    m_BillInterface.SetFieldValue "FPayer", strSql
                    strSql = "update t_BosRpPayApplyBill set FPayer = '" & strSql & "'" & strCondi
                    m_BillInterface.K3Lib.UpdateData strSql
                Case 11, 12 '11:序时簿审核,12:序时簿反审。
                    strSql = "update t_BosRpPayApplyBill set FPayer = '" & strSql & "'" & strCondi
                    m_ListInterface.K3Lib.UpdateData strSql
            End Select
    End Select
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -