📄 bos_wipe2list_plugins.cls
字号:
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 接口实现
'注意: 此方法必须存在, 请勿修改
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
'***********************************************************************************
'导入凭证 根据新的凭证模板
'参数 VouVector 用户选择的报销单据信息
'
'***********************************************************************************
Private Function ImportWipeVou_new(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 sAccItem() 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 iWipeType As String '支出方式
Dim iFSupplyAmtSum As Currency '补领金额
Dim iFRefundAmtsum As Currency '退还金额
Dim iFWipeAmtSum As Currency '报销总额
Dim sFEvectionCause As String '出差事由
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
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("FGroupID") = "1"
'初始化凭证分录集********************************
Set mvchentry = New KFO.Vector
'***********************************************
With VouVector
i = 1
begFor: While i <= VouVector.Size
'取单据编号
lFid = .Item(i)("Fid")
'判断是否生成过凭证, '判断是否已经审核
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 & "失败！原因: 已经生成凭证。" & 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 & "失败！原因: 单据还没有审核。" & vbCrLf
GoTo begFor
End If
End If
If rs.State = adStateOpen Then rs.Close
'取单据信息
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)
'单据存在继续
If rs.State = adStateOpen And rs.RecordCount > 0 Then
iFSupplyAmtSum = CNulls(rs("FSupplyAmtSum"), 0)
iFRefundAmtsum = CNulls(rs("FRefundAmtsum"), 0)
iFWipeAmtSum = CNulls(rs("FWipeAmtSum"), 0)
'-------------------初始化一张单据的凭证分录集----------------------------
Set tmpmvchentry = New KFO.Vector
Set tmpmvchentryD = New KFO.Vector
'--------------------------------------------------------------------------
k = 1
rs.MoveFirst
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")
iWipeType = rs("FWipeType") '支出方式
sFEvectionCause = rs("FEnNote1") '出差事由
'判断报销单的类型
' 1有借款单，且是现金'
' 2有借款单，且是银行存款'
' 3没有借款单，直接借款报销'
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 & "第分录，不能生成凭证！原因：报销单不在3种报销类型中" & vbCrLf
GoTo begwhile
End If
'------------判断报销单的支出方式iWipeType----------------------------
'modified by lxd in 20060312
'如果iwipetype＝0 默认为 现金
If iWipeType = 0 Then
If lLoanType <> 0 Then
iWipeType = lLoanType
Else
iWipeType = "1000201"
End If
End If
'-----------------------------------------------------------------------
' ' 4有借款单，其预借的金额不够。'
'' 5有借款单，且有剩于金额"
' If lfidSRC <> 0 And cWipeAmt > cLoanamt Then
' iVouTplType = 4
' ElseIf lfidSRC <> 0 And cWipeAmt < cLoanamt Then
' iVouTplType = 5
' End If
'-------------------创建1个凭证分录----------------------------
Set entry = New KFO.Dictionary '借方
Set entryD = New KFO.Dictionary '贷方
'-----------------------------------------------------------
'**************************************************************
'写凭证的借方金额
'**************************************************************
entry("FExplanation") = "支出证明单编号：" & sBillNo & vbCrLf & "内容摘要：" & sFEvectionCause
entry("FAccountID") = lWipeItem '写会计科目 ＝
entry("FDC") = 1 '先写借方
entry("FAmount") = cWipeAmt '写借方金额 ，等于报销金额
entry("FQuantity") = 0
entry("FUnitPrice") = 0
entry("FMeasureUnitID") = 0
Set mvchdetail = New KFO.Vector
bret = getAccItem(lWipeItem, sAccItem)
'创建核算项目明细
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
'**************************************************************
'写凭证的贷方金额
'**************************************************************
'-------------------根据支出方式取凭证贷方模板----------------------------
bret = getWipeVouEntryInfo(iVouTplType, iWipeType, sVouType())
'-------------------------------------------------------------------------
If iVouTplType <> 3 And iWipeType <> "1000209" Then
entryD("FExplanation") = "支出证明单编号：" & sBillNo & vbCrLf & "内容摘要：" & sFEvectionCause
entryD("FAccountID") = sVouType(1) '写会计科目 ＝
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)
'创建核算项目明细
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
'**************************************************************
'根据补领和退还金额 追加一个贷方或借方 entryD("FAmount") = cWipeAmt '写贷方金额 ，限额支票时等于报销款金额
'**************************************************************
If iFSupplyAmtSum > 0 Or iFRefundAmtsum > 0 Or iWipeType = "1000209" Then
bret = getWipeVouEntryInfo(3, iWipeType, sVouType())
Set entryD = New KFO.Dictionary '贷方
entryD("FExplanation") = "支出证明单编号：" & sBillNo
entryD("FAccountID") = sVouType(1) '写会计科目 ＝
If iWipeType = "1000209" Then
entryD("FDC") = 0
entryD("FAmount") = iFWipeAmtSum '写贷方金额 ，等于补领金额
Else
If iFSupplyAmtSum > 0 Then
'补写贷方
entryD("FDC") = 0
entryD("FAmount") = iFSupplyAmtSum '写贷方金额 ，等于补领金额
ElseIf iFRefundAmtsum > 0 Then
entryD("FDC") = 1 '补写借方
entryD("FAmount") = iFRefundAmtsum '写贷方金额 ，等于退还金额
End If
End If
entryD("FQuantity") = 0
entryD("FUnitPrice") = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -