bos_loanlist_plugins.cls

完成报销系统的业务流程；在报销系统中达到预算控制目的；将历史数据导入金蝶账套生成历史备查数据。

         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 & "凭证信息－会计期间：" & CStr(rs!FYear) & "." & CStr(rs!FPeriod) & ",凭证字号:" & CStr(rs!GroupName) & " - " & CStr(rs!FNumber)
'            ImportLog12 sInfo
        End If
        '更新单据中的凭证号，凭证制作人
            
        s = "Update t_EP_ER_Loan 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

            
    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
    
End Function
'***********************************************************************************
'取凭证模板的分录信息
'参数 sRet 分录内容
'借款方式  1000201 现金 1000202 支票
'***********************************************************************************
Private Function getVouEntryInfo(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
    sSql = "select * from t_EP_ER_VouTypeEntry where FVouTempletType=1  order by FLoanType, 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) = tmpRs!FLoanType '借款方式
        sRet(2, i) = tmpRs!FVouFdc   '借贷方向
        sRet(3, i) = tmpRs!FAccID   '科目ID
        '根据科目查找对应的核算项目
        sSql = "select t3.FNumber from t_itemdetailv t1 ,t_account t2,t_itemclass t3 " & _
                "where t1.FDetailid=t2.FDetailID and t1.FItemid=-1 and  t2.FAccountid=1098 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
                For j = 1 To 2 '只取两个核算项目
                    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

'取所选单据的凭证号
Private Function getVouid(VouVector As KFO.Vector) As Long
    Dim sSql As String
    Dim vouid As Long
    Dim rs As New ADODB.Recordset
    If VouVector.Size > 0 Then
        With VouVector
            
            '取单据信息
            sSql = "select FVouid ,FVouUser from t_EP_ER_Loan t1 where t1.Fid='" & .Item(1)("Fid") & "'"
            Set rs = m_ListInterface.K3Lib.GetData(sSql)
            If rs.State = adStateOpen And rs.RecordCount = 1 Then
                '判断是否生成过凭证 '判断是否已经审核
                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
'查看时修改单据内的凭证信息
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
        '更新单据中的凭证号，凭证制作人
        
        sSql = "Update t_EP_ER_Loan 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
'判断制单人和审核人是否当前用户
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_Loan 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 "要删除的借款单：" & errStr & "不是当前用户制作！", 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 菜单对象，并设置属性
    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