和平时代的特种兵:通过K3 BOS 新单插件调用老单单据的插件代码能正确新增工业单据

下面是新单插件调用老单单据的插件，你可以参照此方法，在老单插件中调用。

'Call mdlCallIndustryBill.CallBills(5, 1804, 1, 1)
'////////////////////////////单据调用///////////////////////////////////////
'参数说明
' nTranType : 事务类型
' nInterID : 单据ID
' nShowType : 查看模式 （0：新建； 1：EDIT; 2:View)
' nBillType : 单据调用模式(0:普通； 1：单据调单据)
' StateParm : 其他参数，目前主要为BOM使用
' sNewBillType :
' nSaleMode : 内销 or 外销
Private m_BillInterface As BillEvent

Public Declare Function GetCurrentProcessId _
Lib "kernel32" () As Long

Public UserName As String

Public UserId As Long

Public Function CallBills(ByVal nTranType As Long, _
Optional ByVal nInterID As Long = 0, _
Optional ByVal nShowType As Long = 2, _
Optional ByVal nBillType As Long = 0, _
Optional StateParm As Object, _
Optional ByVal sNewBillType As String = "", _
Optional ByVal nSaleMode As Long = 0) As Boolean
Dim objBill As Object
Dim nBillCls As Long '事务类别 （ICTransactiontype.FType）
On Error GoTo lError

'得到单据事务类型的TypeID
If nBillCls = 0 Then nBillCls = GetBillClsID(nTranType)
If nBillCls = 0 Then
MsgBox "单据系统模板错误"
GoTo lError
End If

'-----------------注意：此处参数有改动--------------------'
If nBillType = 0 Then
Set objBill = CreateObject("K3Bills.Bills")
Else
Set objBill = CreateObject("K3BillsEx.Bills")
End If

'-------------------------------------------------------'
Dim dlg As Object
Set dlg = CreateObject("CSystemDlg.Sys")
Dim LocalCnStr As String
Dim sSubID As String
Dim sSubName As String
Dim lModel As Long
Dim lModelDetail As Long
LocalCnStr = dlg.LocalCnn
Set dlg = Nothing

With objBill
.LocalCnn = LocalCnStr
.SystemName = sSubName
.SetOpt UserId, UserName

If Not .SaveVect(1).Lookup("sDsn") Then
.SaveVect(1)("sDsn") = GetConn
End If

If nInterID <> 0 Then
.ListRecordset = SetBillRec(nInterID, nTranType)
.ListRSFieldVect = SetBillVect
End If

If Len(sNewBillType) > 0 Then
.NewBillTransType = sNewBillType
Else
.NewBillTransType = VBA.CStr(nTranType)
End If

.Show nBillCls, nShowType
' 'Add By ChenLianli 用于判断是否单据改变了
' bBillValueChaged = .BillValueChanged
End With

' Set objReturn = objBill.BillReturn
Set objBill = Nothing
CallBills = True
Exit Function
lError:

If Err.Number <> 0 Then MsgBox "单据调用出现异常错误。"
CallBills = False
Set objBill = Nothing
End Function
'取工业单据类型ID
Private Function GetBillClsID(ByVal lTranType As Long) As Long
Dim rs As ADODB.Recordset
Dim objTemp As Object
Dim strSql As String
On Error GoTo lError
strSql = "select FType From ICTransactiontype where fid = " & VBA.CStr(lTranType)
Set rs = m_BillInterface.K3Lib.GetData(strSql)
GetBillClsID = rs.Fields("FType").Value
Set rs = Nothing
Set objTemp = Nothing
Exit Function
lError:
Set rs = Nothing
Set objTemp = Nothing
GetBillClsID = 0
End Function

Private Function SetBillVect() As KFO.Vector
Dim tVect As KFO.Vector
Set tVect = New KFO.Vector
Dim tDict As KFO.Dictionary
Set tDict = New KFO.Dictionary
tDict("FColName") = "FInterID"
tDict("FISPrimary") = 1
tVect.Add tDict
Set tDict = New KFO.Dictionary
tDict("FColName") = "FTranType"
tDict("FISPrimary") = 3
tVect.Add tDict
Set tDict = Nothing
Set SetBillVect = tVect
End Function

'取当前数据库连接
Public Function GetConn() As String
Dim lProc As Long
lProc = GetCurrentProcessId()
Set spmMgr = CreateObject("PropsMgr.ShareProps")

If IsObject(spmMgr.GetProperty(lProc, "PropsString")) Then
GetConn = spmMgr.GetProperty(lProc, "PropsString")
Else
GetConn = spmMgr.GetProperty(lProc, "PropsString")
End If

Set spmMgr = Nothing
Exit Function
End Function

'//////////////////////////////设置选择单据信息//////////////////////////////////'
Private Function SetBillRec(ByVal aInterID As Long, _
ByVal aTranType As Long) As ADODB.Recordset
Dim tRec As ADODB.Recordset
Set tRec = New ADODB.Recordset
tRec.Fields.Append "FInterID", adInteger
tRec.Fields.Append "FTranType", adInteger
tRec.Open
tRec.AddNew
tRec!Finterid = aInterID
tRec!FTranType = aTranType
tRec.Update
Set SetBillRec = tRec
End Function

Public Property Set BillInterface(ByVal vNewValue As Variant)
Set m_BillInterface = vNewValue
End Property