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_LoanList_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"
Option Explicit

 
'定義 ListEvents 接口. 必須具有的聲明, 以此來獲得事件
Private WithEvents m_ListInterface  As ListEvents
Attribute m_ListInterface.VB_VarHelpID = -1
Public mnuBack As KFO.Dictionary
 
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 Vch As Object, Mode As Long
            Dim VchId As Long
    Dim bret As Boolean

        Select Case BOSTool.ToolName
        Case "CreVou"

            bret = ImportLoanVou(m_ListInterface.GetSelectedBillInfo)
        Case "makeVou"
            VchId = getVouid(m_ListInterface.GetSelectedBillInfo)
            If VchId = 0 Then
                bret = ImportLoanVou(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 "viewVou"
        Case "mnuEditDelete"
           If VerUser(m_ListInterface.GetSelectedBillInfo) = False Then
                Cancel = True
           End If
        Case Else
        End Select

End Sub
'***********************************************************************************
'導(dǎo)入憑證
'參數(shù) VouVector 用戶選擇的借款單據(jù)信息
'
'***********************************************************************************
Private Function ImportLoanVou(VouVector As KFO.Vector) As Boolean
    Dim glVouRs As New KFO.Vector
    Dim lFid As Long                            '單據(jù)編號
    Dim glvch As Object                         '中間層憑證對象
    Dim mvch As KFO.Dictionary                  '待保存憑證頭
    Dim mvchentry As KFO.Vector                 '待保存憑證分錄集
    Dim entry As KFO.Dictionary                 '待保存憑證分錄
    Dim mvchdetail As KFO.Vector                '核算項目明細(xì)集
    Dim detail As KFO.Dictionary                '核算項目明細(xì)
    Dim i, iCount As Long, j As Long
    Dim vValue      As Variant
    Dim rs As New ADODB.Recordset
    
    Dim sVouType() As String  '憑證模板數(shù)組
    
    Dim sDepId As String         '部門編碼
    Dim sProposer As String      '申請人編碼
    Dim lLoanItem As Long       '借款項目
    Dim lLoanType As Long       '借款方式
    Dim sBillNo As String       '單據(jù)編碼
    Dim sSql As String
    Dim sInfo As String          '最后提示信息
    Dim sfid As String          '要更新單據(jù)內(nèi)碼集
    Dim bret As Boolean

    Dim tmpRs As New ADODB.Recordset
    On Error GoTo ERR
    sInfo = ""
    '此處添加處理 生成憑頭
    Set mvch = New KFO.Dictionary
    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("FDate") = m_ListInterface.K3Lib.GetData("SELECT GETDATE() AS FDate")("Fdate")
    mvch("FGroupID") = "1"
'    mvch("FReference") =
    
    Set mvchentry = New KFO.Vector
    '取憑證分錄模板
     bret = getVouEntryInfo(sVouType())
     If bret = False Then
        MsgBox "請設(shè)置借款申請單的憑證模板！"
        ImportLoanVou = False
        Exit Function
     End If
    
    With VouVector
    i = 1
begFor: While i <= VouVector.Size
            '取單據(jù)編號
            lFid = .Item(i)("Fid")
            '取單據(jù)信息
            sSql = "select t2.Fnumber as DepNum,t3.Fnumber as ProposerNum,* from t_EP_ER_Loan t1" & _
                    " left join t_item t2 on t2.Fitemclassid=2 and  t1.FReqDept =t2.Fitemid " & _
                    "left join t_item t3 on t3.Fitemclassid=3 and  t1.FProposer =t3.Fitemid where t1.Fid='" & lFid & "'"
                    
            Set rs = m_ListInterface.K3Lib.GetData(sSql)
            If rs.State = adStateOpen And rs.RecordCount = 1 Then
                '判斷是否生成過憑證 '判斷是否已經(jīng)審核
                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 & "借款申請單：" & rs("FBillno") & "生成憑證失??！原因：已經(jīng)生成憑證" & vbCrLf
                        GoTo begFor
                    End If
                    Set tmpRs = Nothing
                End If

                If CLng(rs("FUser")) = 0 Then
                     i = i + 1
                     sInfo = sInfo & "借款申請單：" & rs("FBillno") & "生成憑證失??！原因: 單據(jù)還沒有審核。" & vbCrLf
                     GoTo begFor
                End If

            End If
  
                '部門 ,申請人，金額，借款項目
                sDepId = rs("DepNum")
                sProposer = rs("ProposerNum")
                vValue = rs("FCtlAmt")
                lLoanItem = rs("FLoanItem")
                lLoanType = rs("FLoanType")
                sBillNo = rs("FBillno")

                '創(chuàng)建憑證分錄
                Set entry = New KFO.Dictionary
                
                If lLoanType = 1000203 Then lLoanType = 1000202
                
                For j = 1 To UBound(sVouType, 2)
                    If sVouType(1, j) = lLoanType Then '借款方式相同
                        Set entry = New KFO.Dictionary
                        entry("FExplanation") = "借款申請單，單據(jù)編號：" & sBillNo & vbCrLf & "借款用途：" & CNulls(rs("FNote1"), "")
                        entry("FAccountID") = sVouType(3, j)
                        entry("FDC") = sVouType(2, j)
                        entry("FAmount") = vValue
                        entry("FQuantity") = 0
                        entry("FUnitPrice") = 0
                        entry("FMeasureUnitID") = 0
                                            
                        Set mvchdetail = New KFO.Vector
                        '創(chuàng)建核算項目明細(xì)
                        If sVouType(4, j) <> "" Then
                            
                            Set detail = New KFO.Dictionary
                            detail("FItemClassNumber") = sVouType(4, j)
                            If sVouType(4, j) = "002" Then detail("FItemNumber") = sDepId
                            If sVouType(4, j) = "003" Then detail("FItemNumber") = sProposer
                            mvchdetail.Add detail
                        End If
                        If sVouType(5, j) <> "" Then
'                            Set mvchdetail = New KFO.Vector
                            Set detail = New KFO.Dictionary
                            detail("FItemClassNumber") = sVouType(5, j)
                            If sVouType(5, j) = "002" Then detail("FItemNumber") = sDepId
                            If sVouType(5, j) = "003" Then detail("FItemNumber") = sProposer
                            mvchdetail.Add detail
                            
                        End If
                       Set entry("_Details") = mvchdetail
                        mvchentry.Add entry
                       
                    End If
                Next j
                '拼生憑證正確的單據(jù)內(nèi)碼
                If entry.Count <> 0 Then
                    If sfid = "" Then
                        sfid = sfid & CStr(lFid)
                    Else
                        sfid = sfid & "," & CStr(lFid)
                    End If
                    sInfo = sInfo & "借款申請單：" & rs("FBillno") & "生成憑證成功！" & vbCrLf
                Else
                    sInfo = sInfo & "借款申請單：" & rs("FBillno") & "生成憑證失??！原因：該借款方式的憑證模板設(shè)置錯誤！" & vbCrLf
                End If
            
            If rs.State = adStateOpen Then rs.Close
            i = i + 1