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)