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
                       tmpmvchentry.Add entry
'                        mvchentry.Add entry
      
                    Next j
                     '有借款單，其預(yù)借的金額不夠 貸方多加一個(gè)現(xiàn)金分錄
                     If iVouTplType = 4 Then
                        Set entry = New KFO.Dictionary
                        entry("FExplanation") = "支出憑單，單據(jù)編號(hào)：" & sBillNo
                        entry("FAccountID") = "1000"
                        entry("FDC") = 0
                        entry("FAmount") = cWipeAmt - cLoanamt
                        entry("FQuantity") = 0
                        entry("FUnitPrice") = 0
                        entry("FMeasureUnitID") = 0
                        Set mvchdetail = New KFO.Vector
                        Set entry("_Details") = mvchdetail
                       tmpmvchentry.Add entry
'                        mvchentry.Add entry
                    End If
                    '5有借款單，且有剩于金額" 借方多加一個(gè)現(xiàn)金分錄
                    If iVouTplType = 5 Then
                        Set entry = New KFO.Dictionary
                        entry("FExplanation") = "支出憑單，單據(jù)編號(hào)：" & sBillNo
                        entry("FAccountID") = 1000
                        entry("FDC") = 1
                        entry("FAmount") = cLoanamt - cWipeAmt
                        entry("FQuantity") = 0
                        entry("FUnitPrice") = 0
                        entry("FMeasureUnitID") = 0
                        Set mvchdetail = New KFO.Vector
                        Set entry("_Details") = mvchdetail
                       tmpmvchentry.Add entry
'                        mvchentry.Add entry
                    End If
                    
                     k = k + 1
                     rs.MoveNext
                Wend
                '拼生憑證正確的單據(jù)內(nèi)碼
                If tmpmvchentry.Size > 0 Then
                    For j = 1 To tmpmvchentry.Size
                        mvchentry.Add tmpmvchentry.Item(j)
                    Next j
            
                   If sfid = "" Then
                       sfid = sfid & CStr(lFid)
                   Else
                       sfid = sfid & "," & CStr(lFid)
                   End If
                   sInfo = sInfo & "支出憑單：" & sBillNo & "生成憑證成功！" & vbCrLf
                Else
                    sInfo = sInfo & "支出憑單：" & sBillNo & "生成憑證失敗！原因如上" & ERR.Description & vbCrLf
             
                End If
            End If
            If rs.State = adStateOpen Then rs.Close
            i = i + 1
         Wend
         
        Set mvch("_Entries") = mvchentry
    End With
    Dim s As String

    '如果憑證分錄集不為空，則提交中間層組件生成憑證
    Dim VouInfo
    If mvch("_Entries").Size <> 0 Then
    
 'modify by christin 20060807
        s = GetConnectionProperty("PropsString")
'        s = MMTS.PropsString
'        s = "ConnectString={Provider=SQLOLEDB.1;User ID=sa;Password=;Data Source=KINGDEEKFB;Initial Catalog=AIS20051221092013};UserName=administrator;UserID=16394;DBMS Name=Microsoft SQL Server;DBMS Version=2000;SubID=k3bos;AcctType=gy;Setuptype=Industry;Language=chs;IP=127.0.0.1;MachineName=KINGDEEKFB;UUID=68C61112-D052-4DFC-B43B-DD3028222ACB"
        Set glvch = m_ListInterface.K3Lib.CreateK3Object("EBSGLVoucher.VoucherUpdate")
        VouInfo = glvch.Create(s, mvch)
        '彈出憑證界面修改憑證
        Dim Vch As Object, Mode As Long
        Set Vch = CreateObject("Mvedit.MVoucherEdit")
        Mode = 2
        Vch.LoadVoucher Mode, VouInfo
        Set Vch = Nothing
        '取憑證信息
        sSql = "select t1.*,t2.FName as GroupName from t_voucher  t1 " & _
                            "left join t_Vouchergroup  t2 on t1.FGroupID= t2.FGroupid where FvoucherID=" & VouInfo

        Set rs = m_ListInterface.K3Lib.GetData(sSql)

        If rs.State = adStateOpen And rs.RecordCount = 1 Then

            sInfo = sInfo & "憑證信息－會(huì)計(jì)期間：" & CStr(rs!FYear) & "." & CStr(rs!FPeriod) & ",憑證字號(hào):" & CStr(rs!GroupName) & " - " & CStr(rs!FNumber)
'            ImportLog12 sInfo
        End If
        '更新單據(jù)中的憑證號(hào)
        s = "Update t_EP_ER_WipeOff1 set FVouID=" & VouInfo & ", FVouUser=" & m_ListInterface.K3Lib.User.UserID & ",FVouInfo= '" & CStr(rs!GroupName) & " - " & CStr(rs!FNumber) & "' where fid in (" & sfid & ")"

         m_ListInterface.K3Lib.UpdateData s
         If rs.State = adStateOpen Then rs.Close
        Set rs = Nothing
    End If
    
    MsgBox "支出憑單憑證生成完成！" & vbCrLf & sInfo, vbInformation + vbOKOnly, "金蝶提示"
    ImportLoanVou = True
    Exit Function
ERR:
    Set glVouRs = Nothing
    Set glvch = Nothing
    Set mvch = Nothing
    Set mvchentry = Nothing
    Set entry = Nothing
    Set mvchdetail = Nothing
    Set detail = Nothing
    MsgBox ERR.Number & "-" & ERR.Description, vbOKOnly + vbExclamation, HINTINFO
End Function
'***********************************************************************************
'取報(bào)銷憑證模板的分錄信息
'iVouTplType    憑證模板類型 1 有借款單，且是現(xiàn)金  2 有借款單，且是銀行存款  3 沒有借款單
'iWipeType      支出方式
'參數(shù) sRet      分錄內(nèi)容
'支出方式  1000201 現(xiàn)金 >＝1000202 支票
'***********************************************************************************
Private Function getWipeVouEntryInfo(iVouTplType As Integer, iWipeType As String, ByRef sRet() As String) As Boolean
    Dim sSql As String
    Dim i As Integer, j As Integer
    Dim tmpRs As New ADODB.Recordset
    Dim iCun As Integer
    ReDim sRet(1)
    sSql = "select * from t_EP_ER_WipeVouTypeEntry1 where FVouWipeType='" & iVouTplType & "'and FWipeType='" & iWipeType & "'"
    
    Set tmpRs = m_ListInterface.K3Lib.GetData(sSql)
    If tmpRs.State = adStateOpen And tmpRs.EOF Then
        getWipeVouEntryInfo = False
        Exit Function
    End If
    
    sRet(1) = tmpRs!FAccID

    Set tmpRs = Nothing
    
End Function
'***********************************************************************************
'取憑證模板的分錄信息
'lDep           部門
'lWipeItem      報(bào)銷項(xiàng)目
'iVouTplType    憑證模板類型
'參數(shù) sRet      分錄內(nèi)容
'借款方式  1000201 現(xiàn)金 1000202 支票
'***********************************************************************************
Private Function getVouEntryInfo(lDep As Long, lWipeItem As Long, iVouTplType As Integer, ByRef sRet() As String) As Boolean

    Dim sSql As String
    Dim i As Integer, j As Integer
    Dim tmpRs As New ADODB.Recordset
    Dim tmpRs1 As New ADODB.Recordset
    Dim iCun As Integer
    sSql = "select * from t_EP_ER_VouTypeEntry where FVouTempletType=2  and FDepid= '" & lDep & "' and FWipeItem= '" & lWipeItem & "'" & _
            " and FVouType='" & iVouTplType & "' order by  FVouFdc DESC "
    On Error GoTo ERR

    Set tmpRs = m_ListInterface.K3Lib.GetData(sSql)
    If tmpRs.State = adStateOpen And tmpRs.EOF Then
        getVouEntryInfo = False
        Exit Function
    End If
    ReDim sRet(1 To 5, 1 To tmpRs.RecordCount)
    i = 1
    tmpRs.MoveFirst
    While Not tmpRs.EOF
        sRet(1, i) = iVouTplType ' 憑證模板類型
        sRet(2, i) = tmpRs!FVouFdc   '借貸方向
        sRet(3, i) = tmpRs!FAccID   '科目ID
        '根據(jù)科目查找對(duì)應(yīng)的核算項(xiàng)目
        sSql = "select t3.FNumber from t_itemdetailv t1 ,t_account t2,t_itemclass t3 " & _
                "where t1.FDetailid=t2.FDetailID and t1.FItemid=-1  and  t1.fitemclassid= t3.fitemclassid " & _
                " and t2.FAccountid='" & tmpRs!FAccID & "'"
        Set tmpRs1 = m_ListInterface.K3Lib.GetData(sSql)
            If tmpRs1.State = adStateOpen And tmpRs1.RecordCount > 0 Then
                If tmpRs1.RecordCount > 2 Then
                    iCun = 2
                Else
                    iCun = tmpRs1.RecordCount
                End If
                For j = 1 To iCun '只取兩個(gè)核算項(xiàng)目
                    sRet(3 + j, i) = tmpRs1!FNumber
                    tmpRs1.MoveNext
                Next j
            End If

 
        i = i + 1
        tmpRs.MoveNext
    Wend
    

    getVouEntryInfo = True
    Set tmpRs = Nothing
    Set tmpRs1 = Nothing
    Exit Function
ERR:
    Set tmpRs = Nothing
    Set tmpRs1 = Nothing
    getVouEntryInfo = False

End Function

'取所選單據(jù)的憑證號(hào)
Private Function getVouid(VouVector As KFO.Vector) As Integer
    Dim sSql As String
    Dim vouid As Long
    If VouVector.Size > 0 Then
        With VouVector
            Dim rs As New ADODB.Recordset
            '取單據(jù)信息
            sSql = "select FVouid ,FVouUser from t_EP_ER_WipeOff1 t1 where t1.Fid='" & .Item(1)("Fid") & "'"
            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

                    vouid = rs!FVouid
                    rs.Close
                    sSql = "select isnull(count(*),0)  as vouCun from t_voucher where fvoucherid= '" & vouid & "'"
                    Set rs = m_ListInterface.K3Lib.GetData(sSql)
                    If rs!vouCun <> 0 Then
                        getVouid = vouid
                    Else
                        getVouid = 0
                    End If
                Else
                    getVouid = 0
                    
                End If

            End If
        End With
    Else
        getVouid = 0
    End If
    Set rs = Nothing
End Function
'查看時(shí)修改單據(jù)內(nèi)的憑證信息
Private Function AlterVouNo(vouid As Long)
    Dim sSql As String
    Dim rs As New ADODB.Recordset
    
    '取憑證信息
    sSql = "select t1.*,t2.FName as GroupName from t_voucher  t1 " & _
                        "left join t_Vouchergroup  t2 on t1.FGroupID= t2.FGroupid where FvoucherID=" & vouid

    Set rs = m_ListInterface.K3Lib.GetData(sSql)

    If rs.State = adStateOpen And rs.RecordCount = 1 Then
        '更新單據(jù)中的憑證號(hào)，憑證制作人
        
        sSql = "Update t_EP_ER_WipeOff1 set  FVouUser=" & m_ListInterface.K3Lib.User.UserID & _
            ",FVouInfo= '" & CStr(rs!GroupName) & " - " & CStr(rs!FNumber) & "'  where FVouid=" & vouid
         m_ListInterface.K3Lib.UpdateData sSql

    End If
    Set rs = Nothing
End Function

'判斷制單人和審核人是否當(dāng)前用戶
Private Function VerUser(SelBillVector As KFO.Vector) As Boolean
    Dim rs As New ADODB.Recordset
    Dim sSql As String
    Dim i As Long
    Dim errStr As String
    errStr = ""
    For i = 1 To SelBillVector.Size
        sSql = "select FBillNo,FBiller,FUser from  t_EP_ER_WipeOff1 where fid= " & SelBillVector.Item(i)("Fid")
         Set rs = m_ListInterface.K3Lib.GetData(sSql)
        If rs.State = adStateOpen And rs.RecordCount = 1 Then
           If m_ListInterface.K3Lib.User.UserID <> rs!FBiller Then
                errStr = errStr & "‘" & rs!FBillNo & "’" & "  "
           End If
        
        End If
    Next i
    
   If errStr <> "" Then
        MsgBox "要?jiǎng)h除的支出憑單：" & errStr & "不是當(dāng)前用戶制作的！", vbOKOnly + vbInformation, HINTINFO
        VerUser = False
    Else
        VerUser = True
    
    End If
End Function

Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand

    '新增 makeVou 菜單對(duì)象，并設(shè)置屬性
    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    '將菜單對(duì)象插入指定工具欄
 
End Sub