金蝶软件提示核算项目不存在（金蝶上级核算项目不存在）

1.添加组件引用

金蝶软件提示核算项目不存在,金蝶上级核算项目不存在(1)

2.登录验证，获取K/3连接字符串。

Private K3Login As Object '当前连接对象

Private Sub Login()

On Error GoTo Conn_Error

Set K3Login = CreateObject("K3Login.ClsLogin")

If Not K3Login.CheckLogin Then

AddString "连接不成功"

Set K3Login = Nothing

Exit Sub

End If

Conn_Error:

AddString "ErrCode:" & Err & " ErrDescription:" & Err.Description

End Sub

3.保存凭证（包括凭证分录，核算科目及现金流）

Private Function SaveVoucher() As Long

On Error GoTo ErrHandle

Dim Voucher As New KFO.Dictionary

Dim Dt As New KFO.Dictionary

Dim dtVector As New KFO.Vector

Dim VoucherEntry As New KFO.Vector

Dim tempEntry As KFO.Dictionary

'当前期间凭证日期

Voucher("FDate") = "2015/9/1"

'凭证字

Voucher("FGroup") = "记"

'凭证号注意不能重复，重复则报错

Voucher("FNumber") = 611

'***********************************************

'添加第一条分录

Set tempEntry = New KFO.Dictionary

'摘要

tempEntry("FExplanation") = "凭证录入检测-分录1"

'科目ID t_Account表的FAccountID字段

tempEntry("FAccountID") = 1020

'币别

tempEntry("FCurrencyID") = 1

'借方

tempEntry("FDC") = 1

'原币

tempEntry("FAmountFor") = 100

'本位币

tempEntry("FAmount") = 100

'==============================================

'保存带核算项目的部分

'第一个核算项目

Set Dt = New KFO.Dictionary

'核算项目ID t_ItemClass表FSQLTableName对应表的FItemID

Dt("FItemID") = 305

'核算项目类型 t_ItemClass表FItemClassID

Dt("FItemClassID") = 1

dtVector.Add Dt

'第二个核算项目

Set Dt = New KFO.Dictionary

Dt("FItemID") = 10049

Dt("FItemClassID") = 3

dtVector.Add Dt

Set tempEntry("_Details") = dtVector

' '现金流

' Dim cashFlowDetail As New KFO.Vector

' Set Dt = New KFO.Dictionary

'' select * from t_Item where FItemClassID=9 的FitemID

' Dt("FitemID") = 95

' '顺序号，对应科目所在凭证分录的行号减1

' Dt("FEntryID") = 1

' Dt("FAmountFor") = 600

' Dt("FAmount") = 600

' cashFlowDetail.Add Dt

' Set Dt = New KFO.Dictionary

' Dt("FitemID") = 95

' Dt("FEntryID") = 2

' Dt("FAmountFor") = 400

' Dt("FAmount") = 400

' cashFlowDetail.Add Dt

' Set tempEntry("CashFlow") = cashFlowDetail

'==============================================

VoucherEntry.Add tempEntry

'***********************************************

'添加第二条分录

Set tempEntry = New KFO.Dictionary

tempEntry("FExplanation") = "凭证录入检测-分录2"

tempEntry("FAccountID") = 1242

tempEntry("FCurrencyID") = 1

'贷方

tempEntry("FDC") = 0

tempEntry("FAmountFor") = 100

tempEntry("FAmount") = 100

VoucherEntry.Add tempEntry

'***********************************************

Set Voucher("_Entries") = VoucherEntry

Dim Cre As Object, VoucherID As Long

Set Cre = CreateObject("EBSGLVoucher.VoucherUpdate")

VoucherID = Cre.Create(K3Login.PropsString, Voucher)

Set Cre = Nothing

SaveVoucher = VoucherID ‘返回的凭证id

Exit Function

ErrHandle:

HandleError Err

End Function

‘删除凭证

Private Function DeleteVoucher(ByVal VoucherID As Long) As Boolean

On Error GoTo ErrHandle

DeleteVoucher = False

Dim DelV As Object

Set DelV = CreateObject("EBSGLVoucher.VoucherUpdate")

DeleteVoucher = DelV.Delete(K3Login.PropString, VoucherID)

Set DelV = Nothing

Exit Function

ErrHandle:

HandleError Err

End Function

'取得指定的科目的核算项目，lAcctID为科目ID

Private Function GetItemofAcct(lAcctID As Long) As Object

Dim obj As Object

Dim rsAcct As Object

Dim dtVector As kfo.Vector

Dim Dt As kfo.Dictionary

Set obj = CreateObject("EbcglView.GlData")

Set rsAcct = obj.GetAccountItem(lAcctID)

If rsAcct Is Nothing Then Exit Function

'将取得核算项目打包

Set dtVector = New kfo.Vector

If rsAcct.RecordCount <> 0 Then

rsAcct.MoveFirst

Do While Not rsAcct.EOF

Set Dt = New kfo.Dictionary

Dt("FItemID") = "输入核算项目ID"

Dt("FItemClassID") = "输入核算项目类型"

dtVector.Add Dt

rsAcct.movenext

Loop

End If

Set GetItemofAcct = dtVector

End Function

新增凭证带界面

Public Function CreateVoucherUI() As Long

Dim Voucher As Object '凭证对象

Dim VoucherEntrys As Object '凭证分录对象

CreateVoucherUI = -1

On Error GoTo e

Set Voucher = CreateObject("EBCGL.Voucher")

Voucher.Construct Nothing, Nothing '建立凭证数据对象

Set VoucherEntrys = Voucher.Entries '设置凭证分录对象

' Voucher.InternalInd = dtHead("InternalInd") '机制凭证信息(可选)

'设置凭证默认日期(可选)

'业务日期

' Voucher.TransDate =””

'凭证日期"

Voucher.VoucherDate = "2015/9/1"

'凭证字id t_VoucherGroup表

Voucher.GroupID = 1

'"322" '凭证号

Voucher.Number =322

'附件数

'Voucher.Attachments =””

'业务模块

'Voucher.TranType = “”

'参考信息

'Voucher.Reference = “”

'增加凭证分录数据

VoucherEntrys.Add

With Voucher.Entries(1)

'凭证分录摘要

.Explanation = "凭证录入检测-分录1"

'科目ID

.AccountID = 1020

'本位币

.Amount = 100

'原币

.AmountFor = 100

'汇率

'.ExchangeRate = 1

'币别

.CurrencyID = 1

'借方

.DC = 1

'增加一个核算项目

Voucher.Entries(1).Details.Add

'核算项目类型 t_ItemClass表FItemClassID

Voucher.Entries(1).Details(1).ItemClassID = 1

'核算项目ID t_ItemClass表FSQLTableName对应表的FItemID

Voucher.Entries(1).Details(1).ItemID = 305

'增加第二个核算项目

Voucher.Entries(1).Details.Add

Voucher.Entries(1).Details(2).ItemClassID = 3

Voucher.Entries(1).Details(2).ItemID = 10049

End With

VoucherEntrys.Add

With Voucher.Entries(2)

.Explanation = "凭证录入检测-分录2" '"凭证分录摘要

.AccountID = 1111

.Amount = 100

.AmountFor = 100

.CurrencyID = 1

'贷方

.DC = 0

End With

Dim Vch As Object, Mode As Long

Dim ReturnVoucherID As Long

Set Vch = CreateObject("Mvedit.MVoucherEdit")

'Mode值= '新增 0 '显示 1 '修改 2 '审核 3

'凭证新增(界面数据)

Mode = 0

ReturnVoucherID = 0

If Voucher Is Nothing Then Exit Function

Dim rel As KDVBF.Relevancy

Set rel = New KDVBF.Relevancy '建立输入对象

Set rel.EditObject = Voucher '设置凭证数据对象到Rel参数

rel.MultiEdit = False '是否允许多张凭证编辑

Vch.LoadVoucher Mode, , rel, , ReturnVoucherID

CreateVoucherUI = ReturnVoucherID

Exit Function

CreateVoucherUI = -1

MsgBox Err.Description, vbCritical, "错误提示"

End Function

4．其他相关资料介绍

取当前期间年份

select FValue from t_SystemProfile

where FCategory='GL' AND FKEY='CurrentYear'

取当前期间期数

select FValue from t_SystemProfile

where FCategory='GL' AND FKEY='CurrentPeriod'

经验

栏目热文

金蝶软件中购款金额怎么不出现（金蝶怎么查应收款明细）

金蝶应收款启用日期怎么修改（金蝶应收款结账结束日期不对）

金蝶软件本期发生额怎么录入（金蝶软件怎样录期初数）

金蝶软件怎样导出本月发生额（金蝶怎么导出当月报表）

金蝶本月没有账怎么跳转到下期（金蝶订单日期改到下个月怎么办）

怎样知道金蝶里反结账到哪月了（金蝶软件怎么反结账到上一年度）

金蝶软件上期金额怎么改（金蝶软件的期数怎么改）

金蝶软件在期末结账后为什么出现（金蝶系统期末结账后能不能反转）

金蝶上月反结账的操作步骤（金蝶软件已经结账了怎么反结账）

金蝶软件本期结账提示未审核单据（金蝶软件无法结账该怎么解决）

文档排行

本站推荐