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_Wipe2List_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 接口實(shí)現(xiàn)
    '注意: 此方法必須存在, 請勿修改
    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
    Dim Vch As Object, Mode As Long
    Dim VchId As Long
        Select Case BOSTool.ToolName
        Case "makeVou"
            VchId = getVouid(m_ListInterface.GetSelectedBillInfo)
            If VchId = 0 Then
                 bret = ImportWipeVou_new(m_ListInterface.GetSelectedBillInfo)
      
            Else
                 '彈出憑證界面修改憑證
                VchId = getVouid(m_ListInterface.GetSelectedBillInfo)
                If VchId <> 0 Then
                    Set Vch = CreateObject("Mvedit.MVoucherEdit")
                    Mode = 2
                    Vch.LoadVoucher Mode, VchId
                    AlterVouNo VchId
                End If
                Set Vch = Nothing
            End If

        Case "mnuEditDelete"
           If VerUser(m_ListInterface.GetSelectedBillInfo) = False Then
                Cancel = True
           End If
        Case Else
        End Select

End Sub
'***********************************************************************************
'導(dǎo)入憑證  根據(jù)新的憑證模板
'參數(shù) VouVector 用戶選擇的報(bào)銷單據(jù)信息
'
'***********************************************************************************
Private Function ImportWipeVou_new(VouVector As KFO.Vector) As Boolean
    Dim glVouRs As New KFO.Vector
    Dim lFid As Long                            '單據(jù)編號(hào)
    Dim glvch As Object                         '中間層憑證對象
    Dim mvch As KFO.Dictionary                  '待保存憑證頭
    Dim mvchentry As KFO.Vector                 '待保存憑證分錄集
    Dim entry As KFO.Dictionary                 '待保存憑證分錄
    Dim mvchdetail As KFO.Vector                '核算項(xiàng)目明細(xì)集
    Dim detail As KFO.Dictionary                '核算項(xiàng)目明細(xì)
    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  '憑證模板數(shù)組
    Dim sAccItem() As String  '憑證科目所帶核算項(xiàng)目數(shù)組
    
    Dim sDepId As String         '部門編碼
    Dim sProposer As String      '申請人編碼
    Dim lWipeItem As Long       '報(bào)銷項(xiàng)目
    Dim lLoanType As Long       '借款方式
    Dim sBillNo As String       '單據(jù)編碼
    Dim cWipeAmt As Currency    '報(bào)銷金額
    Dim cLoanamt As Currency    '借款金額
    Dim lfidSRC As Long         '源單內(nèi)碼
    Dim iVouTplType As Integer  '憑證模板類型
    Dim iWipeType As String    '支出方式
    Dim iFSupplyAmtSum As Currency '補(bǔ)領(lǐng)金額
    Dim iFRefundAmtsum As Currency '退還金額
    Dim iFWipeAmtSum As Currency '報(bào)銷總額
    Dim sFEvectionCause As String  '出差事由
    
    Dim sSql As String
    Dim sInfo As String          '最后提示信息
    Dim sfid As String          '要更新單據(jù)內(nèi)碼集
    Dim tmpmvchentry As KFO.Vector '臨時(shí)保存一張單據(jù)中的分錄集
    Dim bret As Boolean
    Dim sErr As String
    Dim tmpRs As New ADODB.Recordset

    On Error GoTo ERR
    sInfo = ""
   

    '此處添加處理 生成憑頭
    Set mvch = New KFO.Dictionary
    '日期取當(dāng)前會(huì)計(jì)期間
    Dim sYear As String
    Dim sPeriod As String
    sYear = m_ListInterface.K3Lib.GetData("select FValue from t_systemprofile where FCategory='GL' and FKey='CurrentYear'")("FValue")
    sPeriod = m_ListInterface.K3Lib.GetData("select FValue from t_systemprofile where FCategory='GL' and FKey='CurrentPeriod'")("FValue")
    mvch("FDate") = getDate(sYear, sPeriod)

    mvch("FGroupID") = "1"


    '初始化憑證分錄集********************************
    Set mvchentry = New KFO.Vector
    '***********************************************
    With VouVector
    i = 1
begFor: While i <= VouVector.Size
            '取單據(jù)編號(hào)
            lFid = .Item(i)("Fid")
            '判斷是否生成過憑證, '判斷是否已經(jīng)審核
            sSql = "select FVouUser,FVouid,FBillno,FUser from t_EP_ER_WipeOff2 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
                    sSql = "select isnull(count(*),0)  as vouCun from t_voucher where fvoucherid= '" & rs!FVouid & "'"
                    Set tmpRs = m_ListInterface.K3Lib.GetData(sSql)
                    If tmpRs!vouCun <> 0 Then
                        i = i + 1
                        sInfo = sInfo & "失敗！原因: 已經(jīng)生成憑證。" & vbCrLf
                        GoTo begFor
                    End If
                    If rs.State = adStateOpen Then tmpRs.Close
                End If
                If CLng(rs("FUser")) = 0 Then
                     i = i + 1
                     sInfo = sInfo & "失??！原因: 單據(jù)還沒有審核。" & vbCrLf
                     GoTo begFor
                End If

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

            '取單據(jù)信息
            sSql = "select t11.FSupplyAmtSum,t11.FRefundAmtsum,t11.FWipeAmtSum,t2.Fnumber as DepNum,t3.Fnumber as ProposerNum,* from t_EP_ER_WipeOff2Entry1  t1" & _
                    " Inner join t_EP_ER_WipeOff2 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 & "'order by FEntryID"
                    
            Set rs = m_ListInterface.K3Lib.GetData(sSql)
            '單據(jù)存在繼續(xù)
            If rs.State = adStateOpen And rs.RecordCount > 0 Then
                iFSupplyAmtSum = CNulls(rs("FSupplyAmtSum"), 0)
                iFRefundAmtsum = CNulls(rs("FRefundAmtsum"), 0)
                iFWipeAmtSum = CNulls(rs("FWipeAmtSum"), 0)
                '-------------------初始化一張單據(jù)的憑證分錄集----------------------------
                Set tmpmvchentry = New KFO.Vector
                Set tmpmvchentryD = New KFO.Vector
                '--------------------------------------------------------------------------
                k = 1
                rs.MoveFirst
begwhile:      While k <= rs.RecordCount
                    '部門 ,申請人，報(bào)銷項(xiàng)目，借款方式，單據(jù)編號(hào)，報(bào)銷金額，借款金額,源單內(nèi)碼 ,
                    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")
                    iWipeType = rs("FWipeType")  '支出方式
                    sFEvectionCause = rs("FEnNote1") '出差事由
                    
                    '判斷報(bào)銷單的類型
'                        1有借款單，且是現(xiàn)金'
'                        2有借款單，且是銀行存款'
'                        3沒有借款單，直接借款報(bào)銷'

                    If lfidSRC <> 0 And lLoanType = "1000201" Then
                        iVouTplType = 1
                    ElseIf lfidSRC <> 0 And lLoanType <> "1000201" Then
                        iVouTplType = 2
                    ElseIf lfidSRC = 0 Then
                        iVouTplType = 3
                    Else
                        k = k + 1
                        sInfo = sInfo & "支出證明單：" & rs("FBillno") & "中的第" & k & "第分錄，不能生成憑證！原因：報(bào)銷單不在3種報(bào)銷類型中" & vbCrLf
                        GoTo begwhile
                    End If
                    
                    '------------判斷報(bào)銷單的支出方式iWipeType----------------------------
                    'modified by lxd in 20060312
                        '如果iwipetype＝0 默認(rèn)為 現(xiàn)金
                    If iWipeType = 0 Then
                        If lLoanType <> 0 Then
                            iWipeType = lLoanType
                        Else
                            iWipeType = "1000201"
                        End If
                    End If
                    '-----------------------------------------------------------------------
' '                   4有借款單，其預(yù)借的金額不夠。'
''                    5有借款單，且有剩于金額"
'                     If lfidSRC <> 0 And cWipeAmt > cLoanamt Then
'                        iVouTplType = 4
'                    ElseIf lfidSRC <> 0 And cWipeAmt < cLoanamt Then
'                        iVouTplType = 5
'                    End If
                    '-------------------創(chuàng)建1個(gè)憑證分錄----------------------------
                    Set entry = New KFO.Dictionary  '借方
                    Set entryD = New KFO.Dictionary '貸方
                    '-----------------------------------------------------------
                    '**************************************************************
                    '寫憑證的借方金額
                    '**************************************************************
                    entry("FExplanation") = "支出證明單編號(hào)：" & sBillNo & vbCrLf & "內(nèi)容摘要：" & sFEvectionCause
                    entry("FAccountID") = lWipeItem '寫會(huì)計(jì)科目 ＝
                    entry("FDC") = 1                '先寫借方
                    entry("FAmount") = cWipeAmt     '寫借方金額 ，等于報(bào)銷金額
                    entry("FQuantity") = 0
                    entry("FUnitPrice") = 0
                    entry("FMeasureUnitID") = 0
                        
                     Set mvchdetail = New KFO.Vector
                    bret = getAccItem(lWipeItem, sAccItem)
                     '創(chuàng)建核算項(xiàng)目明細(xì)
                     If sAccItem(1) <> "" Then
                         Set detail = New KFO.Dictionary
                         detail("FItemClassNumber") = sAccItem(1)
                         If sAccItem(1) = "002" Then detail("FItemNumber") = sDepId
                         If sAccItem(1) = "003" Then detail("FItemNumber") = sProposer
                         mvchdetail.Add detail
                     End If
                     If sAccItem(2) <> "" Then
                         Set detail = New KFO.Dictionary
                         detail("FItemClassNumber") = sAccItem(2)
                         If sAccItem(2) = "002" Then detail("FItemNumber") = sDepId
                         If sAccItem(2) = "003" Then detail("FItemNumber") = sProposer
                         mvchdetail.Add detail
                         
                     End If
                    Set entry("_Details") = mvchdetail
                    tmpmvchentry.Add entry
                    '**************************************************************
                    '寫憑證的貸方金額
                    '**************************************************************
                    '-------------------根據(jù)支出方式取憑證貸方模板----------------------------
                    bret = getWipeVouEntryInfo(iVouTplType, iWipeType, sVouType())
                    '-------------------------------------------------------------------------
                    If iVouTplType <> 3 And iWipeType <> "1000209" Then
                        entryD("FExplanation") = "支出證明單編號(hào)：" & sBillNo & vbCrLf & "內(nèi)容摘要：" & sFEvectionCause
                        entryD("FAccountID") = sVouType(1) '寫會(huì)計(jì)科目 ＝
                        entryD("FDC") = 0                '先寫貸方
                        entryD("FAmount") = cLoanamt     '寫貸方金額 ，等于借款金額
                        entryD("FQuantity") = 0
                        entryD("FUnitPrice") = 0
                        entryD("FMeasureUnitID") = 0
                            
                         Set mvchdetail = New KFO.Vector
                        bret = getAccItem(CLng(sVouType(1)), sAccItem)
                         '創(chuàng)建核算項(xiàng)目明細(xì)
                         If sAccItem(1) <> "" Then
                             Set detail = New KFO.Dictionary
                             detail("FItemClassNumber") = sAccItem(1)
                             If sAccItem(1) = "002" Then detail("FItemNumber") = sDepId
                             If sAccItem(1) = "003" Then detail("FItemNumber") = sProposer
                             mvchdetail.Add detail
                         End If
                         If sAccItem(2) <> "" Then
                             Set detail = New KFO.Dictionary
                             detail("FItemClassNumber") = sAccItem(2)
                             If sAccItem(2) = "002" Then detail("FItemNumber") = sDepId
                             If sAccItem(2) = "003" Then detail("FItemNumber") = sProposer
                             mvchdetail.Add detail
                             
                         End If
                        Set entryD("_Details") = mvchdetail
                        tmpmvchentryD.Add entryD
                    End If
                     k = k + 1
                     rs.MoveNext
                Wend
                '**************************************************************
                '根據(jù)補(bǔ)領(lǐng)和退還金額 追加一個(gè)貸方或借方 entryD("FAmount") = cWipeAmt     '寫貸方金額 ，限額支票時(shí)等于報(bào)銷款金額
                '**************************************************************
                If iFSupplyAmtSum > 0 Or iFRefundAmtsum > 0 Or iWipeType = "1000209" Then
                    bret = getWipeVouEntryInfo(3, iWipeType, sVouType())
                    Set entryD = New KFO.Dictionary '貸方
               
                    entryD("FExplanation") = "支出證明單編號(hào)：" & sBillNo
                    entryD("FAccountID") = sVouType(1) '寫會(huì)計(jì)科目 ＝
                    If iWipeType = "1000209" Then
                        entryD("FDC") = 0
                        entryD("FAmount") = iFWipeAmtSum     '寫貸方金額 ，等于補(bǔ)領(lǐng)金額
                    Else
                        If iFSupplyAmtSum > 0 Then
                        '補(bǔ)寫貸方
                            entryD("FDC") = 0
                            entryD("FAmount") = iFSupplyAmtSum     '寫貸方金額 ，等于補(bǔ)領(lǐng)金額
                        ElseIf iFRefundAmtsum > 0 Then
                            entryD("FDC") = 1                '補(bǔ)寫借方
                            entryD("FAmount") = iFRefundAmtsum     '寫貸方金額 ，等于退還金額
                        End If
                    End If
                    entryD("FQuantity") = 0
                    entryD("FUnitPrice") = 0