📄 bos_wipe2list_plugins.cls
字号:
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
If entryD("FDC") = 0 Then
tmpmvchentryD.Add entryD
ElseIf entryD("FDC") = 1 Then
tmpmvchentry.Add entryD
End If
End If
'拼生凭证正确的单据内码
If tmpmvchentry.Size > 0 Or tmpmvchentryD.Size > 0 Then
For j = 1 To tmpmvchentry.Size
mvchentry.Add tmpmvchentry.Item(j)
Next j
For j = 1 To tmpmvchentryD.Size
mvchentry.Add tmpmvchentryD.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 & "凭证信息－会计期间：" & CStr(rs!FYear) & "." & CStr(rs!FPeriod) & ",凭证字号:" & CStr(rs!GroupName) & " - " & CStr(rs!FNumber)
' ImportLog12 sInfo
End If
'更新单据中的凭证号
s = "Update t_EP_ER_WipeOff2 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
'***********************************************************************************
'导入凭证
'参数 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
Dim tmpRs As 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
'***********************************************
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 tmpRs.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 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 & "'"
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)
Set entry = New KFO.Dictionary
entry("FExplanation") = "支出证明单，单据编号：" & sBillNo & vbCrLf & "不能取得单据原因：" & CNulls(rs("FNote"), "")
entry("FAccountID") = sVouType(3, j)
entry("FDC") = sVouType(2, j)
'有借款单，其预借的金额不够 贷方多加一个现金分录
If iVouTplType = 4 And sVouType(2, j) = 0 Then
entry("FAmount") = cLoanamt
ElseIf iVouTplType = 4 And sVouType(2, j) = 1 Then
entry("FAmount") = cWipeAmt
'5有借款单，且有剩于金额" 借方多加一个现金分录
ElseIf iVouTplType = 5 And sVouType(2, j) = 1 Then
entry("FAmount") = cWipeAmt
ElseIf iVouTplType = 5 And sVouType(2, j) = 0 Then
entry("FAmount") = cLoanamt
Else
entry("FAmount") = cWipeAmt
End If
entry("FQuantity") = 0
entry("FUnitPrice") = 0
entry("FMeasureUnitID") = 0
Set mvchdetail = New KFO.Vector
'创建核算项目明细
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
tmpmvchentry.Add entry
' mvchentry.Add entry
Next j
'有借款单，其预借的金额不够 贷方多加一个现金分录
If iVouTplType = 4 Then
Set entry = New KFO.Dictionary
entry("FExplanation") = "支出证明单，单据编号：" & 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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -