下面是新單插件調用老單單據(jù)的插件，你可以參照此方法，在老單插件中調用。
'Call mdlCallIndustryBill.CallBills(5, 1804, 1, 1)
'////////////////////////////單據(jù)調用///////////////////////////////////////
'參數(shù)說明
' nTranType : 事務類型
' nInterID : 單據(jù)ID
' nShowType : 查看模式 （0：新建； 1：EDIT; 2:View)
' nBillType : 單據(jù)調用模式(0:普通； 1：單據(jù)調單據(jù))
' StateParm : 其他參數(shù)，目前主要為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
'得到單據(jù)事務類型的TypeID
If nBillCls = 0 Then nBillCls = GetBillClsID(nTranType)
If nBillCls = 0 Then
MsgBox "單據(jù)系統(tǒng)模板錯誤"
GoTo lError
End If
'-----------------注意：此處參數(shù)有改動--------------------'
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 用于判斷是否單據(jù)改變了
' bBillValueChaged = .BillValueChanged
End With
' Set objReturn = objBill.BillReturn
Set objBill = Nothing
CallBills = True
Exit Function
lError:
If Err.Number <> 0 Then MsgBox "單據(jù)調用出現(xiàn)異常錯誤。"
CallBills = False
Set objBill = Nothing
End Function
'取工業(yè)單據(jù)類型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
'取當前數(shù)據(jù)庫連接
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
'//////////////////////////////設置選擇單據(jù)信息//////////////////////////////////'
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
