bos_wipelist_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_WipeList_PlugIns"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "This is ListEvents Interface Class, made by K3BOSPLUGINSWIZAED"
 
'定义 ListEvents 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_ListInterface  As ListEvents
Attribute m_ListInterface.VB_VarHelpID = -1
 
Public Sub Show(ByVal oListInterface As Object)
 
    'ListEvents 接口实现
    '注意: 此方法必须存在, 请勿修改
    Set m_ListInterface = oListInterface
 
End Sub

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

End Sub

Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    Dim bret As Boolean

        Select Case BOSTool.ToolName
        Case "CreVou"
            bret = ImportWipeVou(m_ListInterface.GetSelectedBillInfo)
        Case "makeVou"
            bret = ImportWipeVou(m_ListInterface.GetSelectedBillInfo)
        Case Else
        End Select

End Sub

Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)

    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand

    '新增 makeVou 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("makeVou")
    With oTool
        .Caption = "凭证"
        .ToolTipText = "凭证"
        .Description = "凭证"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = True
        .ToolPicture = App.Path & "\vou.ICO"
        .SetPicture 0, vbButtonFace
    End With

    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool    '将菜单对象插入指定工具栏
 


End Sub
'***********************************************************************************
'导入凭证
'参数 VouVector 用户选择的报销单据信息
'
'***********************************************************************************
Private Function ImportWipeVou(VouVector As KFO.Vector) As Boolean
    Dim glVouRs As New KFO.Vector
    Dim lFid As Long                            '单据编号
    Dim glvch As Object                         '中间层凭证对象
    Dim mvch As KFO.Dictionary                  '待保存凭证头
    Dim mvchentry As KFO.Vector                 '待保存凭证分录集
    Dim entry As KFO.Dictionary                 '待保存凭证分录
    Dim mvchdetail As KFO.Vector                '核算项目明细集
    Dim detail As KFO.Dictionary                '核算项目明细
    Dim i, iCount As Long, j As Long, k As Long
    Dim vValue      As Variant
    Dim rs As New ADODB.Recordset
    
    Dim sVouType() As String  '凭证模板数组
    
    Dim sDepId As String         '部门编码
    Dim sProposer As String      '申请人编码
    Dim lWipeItem As Long       '报销项目
    Dim lLoanType As Long       '借款方式
    Dim sBillNo As String       '单据编码
    Dim cWipeAmt As Currency    '报销金额
    Dim cLoanamt As Currency    '借款金额
    Dim lfidSRC As Long         '源单内码
    Dim iVouTplType As Integer  '凭证模板类型
    
    Dim sSql As String
    Dim sInfo As String          '最后提示信息
    Dim sfid As String          '要更新单据内码集
    Dim tmpmvchentry As KFO.Vector '临时保存一张单据中的分录集
    Dim bret As Boolean
    Dim sErr As String

    On Error GoTo ERR
    sInfo = ""
   

    '此处添加处理 生成凭头
    Set mvch = New KFO.Dictionary
    mvch("FDate") = m_ListInterface.K3Lib.GetData("SELECT GETDATE() AS FDate")("Fdate")
    mvch("FGroupID") = "1"
'    mvch("FReference") =

    '初始化凭证分录集********************************
    Set mvchentry = New KFO.Vector
    '***********************************************
    With VouVector
    i = 1
begFor: While i <= VouVector.Size
            '取单据编号
            lFid = .Item(i)("Fid")
            
            
            '判断是否生成过凭证, '判断是否已经审核
            sSql = "select FVouUser,FBillno,FUser from t_BOSWipeOff t1 where t1.Fid='" & lFid & "'"
            Set rs = m_ListInterface.K3Lib.GetData(sSql)
            If rs.State = adStateOpen And rs.RecordCount > 0 Then
                sInfo = sInfo & "报销单：" & rs("FBillno") & "生成凭证"
                If Not (CStr(rs("FVouUser")) = "" Or CLng(rs("FVouUser") = 0)) <> 0 Then
                    i = i + 1
                    sInfo = sInfo & "失败！原因: 已经生成凭证。" & vbCrLf
                    GoTo begFor
                End If
                If CLng(rs("FUser")) = 0 Then
                     i = i + 1
                     sInfo = sInfo & "失败！原因: 单据还没有审核。" & vbCrLf
                     GoTo begFor
                End If

            End If
            If rs.State = adStateOpen Then rs.Close

            '取单据信息
            sSql = "select  t2.Fnumber as DepNum,t3.Fnumber as ProposerNum,* from t_BOSWipeOffEntry1  t1" & _
                    " Inner join t_BOSWipeOff t11 on t1.fid=t11.fid " & _
                    " left join t_item t2 on t2.Fitemclassid=2 and  t1.FDivideDep =t2.Fitemid " & _
                    " left join t_item t3 on t3.Fitemclassid=3 and  t11.FProposer =t3.Fitemid " & _
                    " where t1.Fid='" & lFid & "'"
                    
            Set rs = m_ListInterface.K3Lib.GetData(sSql)
            '单据存在继续
            If rs.State = adStateOpen And rs.RecordCount > 0 Then
                '初始化一张单据的凭证分录集********************************
                Set tmpmvchentry = New KFO.Vector
                '**********************************************************
                
                k = 1
begwhile:      While k <= rs.RecordCount
        
                    '部门 ,申请人，报销项目，借款方式，单据编号，报销金额，借款金额,源单内码
                    sDepId = rs("DepNum")
                    sProposer = rs("ProposerNum")
                    lWipeItem = rs("FWipeItem")
                    lLoanType = rs("FLoanType")
                    sBillNo = rs("FBillno")
                    cWipeAmt = rs("FWipeAmt")
                    cLoanamt = rs("FLoanAmt")
                    lfidSRC = rs("FID_SRC")
                    
                    '判断报销单的类型
'                        1有借款单，且是现金'
'                        2有借款单，且是银行存款'
'                        3没有借款单，直接借款报销'

                    If lfidSRC <> 0 And lLoanType = "1000201" Then
                        iVouTplType = 1
                    ElseIf lfidSRC <> 0 And lLoanType = "1000202" Then
                        iVouTplType = 2
                    ElseIf lfidSRC = 0 Then
                        iVouTplType = 3

                    Else
                        k = k + 1
                        sInfo = sInfo & "报销单：" & rs("FBillno") & "中的第" & k & "第分录，不能生成凭证！原因：报销单不在5种报销类型中" & vbCrLf
                        GoTo begwhile
                    End If
                    
                    '取凭证分录模板
                    bret = getVouEntryInfo(rs("FDivideDep"), lWipeItem, iVouTplType, sVouType())
                    If bret = False Then
                        k = k + 1
                        sInfo = sInfo & "报销单：" & rs("FBillno") & "中的第" & k & "第分录，不能生成凭证！原因：没有对应的凭证模板" & vbCrLf
                        GoTo begwhile
                       Exit Function
                    End If
                    
 '                   4有借款单，其预借的金额不够。'
'                    5有借款单，且有剩于金额"
                     If lfidSRC <> 0 And cWipeAmt > cLoanamt Then
                        iVouTplType = 4
                    ElseIf lfidSRC <> 0 And cWipeAmt < cLoanamt Then
                        iVouTplType = 5
                    End If
                    '创建凭证分录
                    Set entry = New KFO.Dictionary
                    
                    For j = 1 To UBound(sVouType, 2)