'视图查询一个科目
Private Sub ViewAccount()
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.AccountLookup()
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定科目
Private Sub SearchAccount(ByVal FNumber As String)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetAccount(FNumber)
If Not retObj Is Nothing Then
MsgBox "代码为:" & FNumber & "的科目存在"
Else
MsgBox "代码为:" & FNumber & "的科目不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'视图查询一个客户
Private Sub ViewCust()
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.ItemLookup(1)
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定客户
Private Sub SearchCust(ByVal FNumber As String)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetItem(1, , FNumber)
If Not retObj Is Nothing Then
MsgBox "代码为:" & FNumber & "的客户存在"
Else
MsgBox "代码为:" & FNumber & "的客户不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'视图查询一个部门
Private Sub ViewDept()
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.ItemLookup(2)
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定部门
Private Sub SearchDept(ByVal FNumber As String)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetItem(2, , FNumber)
If Not retObj Is Nothing Then
MsgBox "代码为:" & FNumber & "的部门存在"
Else
MsgBox "代码为:" & FNumber & "的部门不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'视图查询一个职员
Private Sub ViewEMP()
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.ItemLookup(3)
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定职员
Private Sub SearchEMP(ByVal FNumber As String)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetItem(3, , FNumber)
If Not retObj Is Nothing Then
MsgBox "代码为:" & FNumber & "的职员存在"
Else
MsgBox "代码为:" & FNumber & "的职员不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'视图查询一个物料
Private Sub ViewICItem()
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.ItemLookup(4)
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定物料
Private Sub SearchICItem(ByVal FNumber As String)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetItem(4, , FNumber)
If Not retObj Is Nothing Then
MsgBox "代码为:" & FNumber & "的物料存在"
Else
MsgBox "代码为:" & FNumber & "的物料不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'视图查询一个仓库
Private Sub ViewStock()
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.ItemLookup(5)
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定仓库
Private Sub SearchStock(ByVal FNumber As String)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetItem(5, , FNumber)
If Not retObj Is Nothing Then
MsgBox "代码为:" & FNumber & "的仓库存在"
Else
MsgBox "代码为:" & FNumber & "的仓库不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'视图查询一个计量单位
Private Sub ViewUnit()
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.UnitGroupLookup()
If retObj.ReturnOK Then
txtUnitGroup.Tag = retObj.ReturnValue
txtUnitGroup = retObj.ReturnObject.Name
': m_GroupName : "寸" : String : frmLookUp.ViewUnit
Set retObj = obj.UnitLookup(retObj.ReturnValue)
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定计量单位
Private Sub SearchUnit(ByVal FNumber As String)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetUnit(Val(txtUnitGroup.Tag), , FNumber)
If Not retObj Is Nothing Then
MsgBox "计量单位组为:" & txtUnitGroup & "代码为:" & FNumber & "的计量单位存在"
Else
MsgBox "计量单位组为:" & txtUnitGroup & "代码为:" & FNumber & "的计量单位不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'视图查询一个供应商
Private Sub ViewSupply()
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.ItemLookup(8)
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定供应商
Private Sub SearchSupply(ByVal FNumber As String)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetItem(8, , FNumber)
If Not retObj Is Nothing Then
MsgBox "代码为:" & FNumber & "的供应商存在"
Else
MsgBox "代码为:" & FNumber & "的供应商不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'视图查询一个辅助资料(职务)
Private Sub ViewSubMessage(ByVal TypeID As Long)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLView")
Set retObj = obj.SubMesLookup(TypeID)
If retObj.ReturnOK Then
txtNumber.Text = retObj.ReturnObject.Number
': AccountID : 1003 : Long : frmLookUp.ViewAccount
'如果要得到更加详细的信息可以访问retObj.ReturnObject对象
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
'查询指定辅助资料(职务)
Private Sub SearchSubMessage(ByVal FNumber As String, ByVal TypeID As Long)
'添加错误陷阱
On Error GoTo HERROR
Dim obj As Object
Dim retObj As Object
Set obj = CreateObject("EBCGLView.GLData")
Set retObj = obj.GetSubMes(TypeID, , FNumber)
If Not retObj Is Nothing Then
MsgBox "代码为:" & FNumber & "的辅助资料存在"
Else
MsgBox "代码为:" & FNumber & "的辅助资料不存在"
End If
Set obj = Nothing
Set retObj = Nothing
Exit Sub
HERROR:
MsgBox Err.Description
End Sub
Private Sub cboClass_Click()
If Val(Mid(cboClass.Text, 100)) = 7 Then
txtUnitGroup.Visible = True
lblUnitGroup.Visible = True
Else
txtUnitGroup.Visible = False
lblUnitGroup.Visible = False
End If
End Sub
Private Sub cmdExplore_Click()
Select Case Val(Mid(cboClass.Text, 100))
Case 0
ViewAccount
Case 1
ViewCust
Case 2
ViewDept
Case 3
ViewEMP
Case 4
ViewICItem
Case 5
ViewStock
Case 7
ViewUnit
Case 8
ViewSupply
Case 29
ViewSubMessage 29
Case 35
ViewSubMessage 35
Case 130
Case 32
End Select
End Sub
Private Sub cmdFind_Click()
If Len(txtNumber) = 0 Then Exit Sub
Select Case Val(Mid(cboClass.Text, 100))
Case 0
SearchAccount txtNumber
Case 1
SearchCust txtNumber
Case 2
SearchDept txtNumber
Case 3
SearchEMP txtNumber
Case 4
SearchICItem txtNumber
Case 5
SearchStock txtNumber
Case 7
SearchUnit txtNumber
Case 8
SearchSupply txtNumber
Case 29
SearchSubMessage txtNumber, 29
Case 35
SearchSubMessage txtNumber, 35
Case 130
Case 32
End Select
End Sub
Private Sub UserForm_Initialize()
'信息参见表t_ItemClass、t_SubMesType
cboClass.AddItem "科目" & Space(100) & "0"
cboClass.AddItem "客户" & Space(100) & "1"
cboClass.AddItem "部门" & Space(100) & "2"
cboClass.AddItem "职员" & Space(100) & "3"
cboClass.AddItem "物料" & Space(100) & "4"
cboClass.AddItem "仓库 " & Space(100) & "5"
cboClass.AddItem "计量单位" & Space(100) & "7"
cboClass.AddItem "供应商" & Space(100) & "8"
cboClass.AddItem "辅助资料(职务)" & Space(100) & "29"
cboClass.AddItem "辅助资料(结算期限)" & Space(100) & "35"
'如果是其他资料就采用类似的方法,自定义核算项目和系统预设的核算处理方式相同
cboClass.ListIndex = 0
InitText
End Sub
Private Sub InitText()
Text1.Text = "名称 内部内码值 查询方法 查找方法" & vbCrLf & _
"科目 <无> EBCGLView.GLView.AccountLookup() EBCGLView.GLData.GetAccount(FNumber)" & vbCrLf & "币别 <无> EBCGLView.GLView.CurrencyLookup() EBCGLView.GLData.GetCurrency(FNumber)" & vbCrLf & _
"计量单位 <无> EBCGLView.GLView.UnitLookup(GroupID) EBCGLView.GLData.GetUnit(,,FNumber)" & vbCrLf & "计量单位组 <无> EBCGLView.GLView.UnitGroupLookup() EBCGLView.GLData.GetUnitGroup(FNumber)" & vbCrLf & _
"客户 1 EBCGLView.GLView.ItemLookup(1) EBCGLView.GLData.GetItem(1, , FNumber)" & vbCrLf & "部门 2 EBCGLView.GLView.ItemLookup(2) EBCGLView.GLData.GetItem(2, , FNumber)" & vbCrLf & _
"职员 3 EBCGLView.GLView.ItemLookup(3) EBCGLView.GLData.GetItem(3, , FNumber)" & vbCrLf & "物料 4 EBCGLView.GLView.ItemLookup(4) EBCGLView.GLData.GetItem(4, , FNumber)" & vbCrLf & _
"仓库 5 EBCGLView.GLView.ItemLookup(5) EBCGLView.GLData.GetItem(5, , FNumber)" & vbCrLf & _
"供应商 8 EBCGLView.GLView.ItemLookup(8) EBCGLView.GLData.GetItem(8, , FNumber)" & vbCrLf & _
"采购费用种类 20 EBCGLView.GLView.SubMesLookup(20) EBCGLView.GLData.GetSubMes(20, , FNumber)" & vbCrLf & _
"运输方式 21 EBCGLView.GLView.SubMesLookup(21) EBCGLView.GLData.GetSubMes(21, , FNumber)" & vbCrLf & _
"原因 22 EBCGLView.GLView.SubMesLookup(22) EBCGLView.GLData.GetSubMes(22, , FNumber)" & vbCrLf & _
"职称 24 EBCGLView.GLView.SubMesLookup(24) EBCGLView.GLData.GetSubMes(24, , FNumber)" & vbCrLf & _
"行业 25 EBCGLView.GLView.SubMesLookup(25) EBCGLView.GLData.GetSubMes(25, , FNumber)" & vbCrLf & _
"区域 26 EBCGLView.GLView.SubMesLookup(26) EBCGLView.GLData.GetSubMes(26, , FNumber)" & vbCrLf & _
"付款期限 28 EBCGLView.GLView.SubMesLookup(28) EBCGLView.GLData.GetSubMes(28, , FNumber)" & vbCrLf & _
"供应商类别 27 EBCGLView.GLView.SubMesLookup(27) EBCGLView.GLData.GetSubMes(27, , FNumber)" & vbCrLf & _
"职务 29 EBCGLView.GLView.SubMesLookup(29) EBCGLView.GLData.GetSubMes(29, , FNumber)" & vbCrLf & _
"职员类别 30 EBCGLView.GLView.SubMesLookup(30) EBCGLView.GLData.GetSubMes(30, , FNumber)" & vbCrLf & _
"结算期限 35 EBCGLView.GLView.SubMesLookup(35) EBCGLView.GLData.GetSubMes(35, , FNumber)" & vbCrLf & _
"所有制 50 EBCGLView.GLView.SubMesLookup(50) EBCGLView.GLData.GetSubMes(50, , FNumber)" & vbCrLf & _
"资产关系 51 EBCGLView.GLView.SubMesLookup(51) EBCGLView.GLData.GetSubMes(51, , FNumber)" & vbCrLf & _
"上级主管 52 EBCGLView.GLView.SubMesLookup(52) EBCGLView.GLData.GetSubMes(52, , FNumber)" & vbCrLf & _
"结算方式 130 EBCGLView.GLView.SubMesLookup(130) EBCGLView.GLData.GetSubMes(130, , FNumber)" & vbCrLf & _
"文化程度 23 EBCGLView.GLView.SubMesLookup(23) EBCGLView.GLData.GetSubMes(23, , FNumber)" & vbCrLf & _
"交货方式 32 EBCGLView.GLView.SubMesLookup(32) EBCGLView.GLData.GetSubMes(32, , FNumber)" & vbCrLf & _
"价格类型 245 EBCGLView.GLView.SubMesLookup(245) EBCGLView.GLData.GetSubMes(245, , FNumber)"
End Sub
K3查询基础资料开发代码
最新推荐文章于 2017-07-18 16:34:00 发布