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
e:
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
相关数据表及介绍
t_voucher 凭证主表
t_voucherentry 凭证分录表
t_CashFlowBal 现金流量分录表
t_Account 科目表
select * from t_Item where FItemClassID=9 为现金流量主表项目。
其他详细内容请参考C:Program FilesKingdeeK3ERPKDSDKSampleK3Login&Vch
5.代码文件
版权声明：本文内容由互联网用户自发贡献，该文观点仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容， 请发送邮件至123456@qq.com 举报，一经查实，本站将立刻删除。
