目 录
1 引言 ................................................................................................................. 3
1.1 阅读对象 ......................................................................................................................... 3
1.2 U8 二次开发概述 ........................................................................................................... 3
1.3 U8 使用以及二次开发现存问题 ................................................................................... 3
1.3.1 U8 使用问题 ............................................................................................................... 3
1.3.2 二次开发现存问题 ................................................................................................. 3
1.4 编写目的 ......................................................................................................................... 4
2 控件使用 ......................................................................................................... 4
2.1 开发环境 ......................................................................................................................... 4
2.2 单据控件 ......................................................................................................................... 4
2.2.1 如何使单据自定义项根据用户的需求弹出参照 ................................................. 4
2.2.2 库存单据 USER-PCO 控件的使用 ...................................................................... 14
2.2.3 单据标准（排序、合并、批改等功能） ........................................................... 20
2.2.4 单据参照的调用 ................................................................................................... 24
2.2.5 单据打印标准化 ................................................................................................... 31
2.3 单据列表控件 ............................................................................................................... 32
2.3.1 单据列表输出功能 ............................................................................................... 32
2.3.2 单据列表的分页功能 ........................................................................................... 32
2.3.3 单据列表的定位功能（列表数据定位） ........................................................... 37
1 引言
1.1 阅读对象
本文档针对参与用友 U8-ERP 870 及以上版本平台产品插件二次开发的技术
人员，读者必须具备一定的软件开发基础，并对 U870 及以上版本插件开发技术
有一定的了解。
1.2 U8 二次开发概述
目前，各个行业之间，如服装、化工、食品、机械等各个行业之间，差异越
来越大，行业的细分化越来越大，各个行业都存在其比较特殊的行业特性，ERP
产品为了把开发的数量减少到最低，缩短实施周期，减少项目投入，减少实施的
成本，ERP 产品必须走行业化道路才行。因此对于标准产品用友 ERP-U8，要适
应行业的发展也必须走行业化的道路。
1.3 U8 使用以及二次开发现存问题
1.3.1 U8 使用问题
不具备行业化特性，针对具体的行业，尤其是服装、化工、
食品等个性化鲜明的行业，U8 产品可以解决企业信息化的大部
分需求，但要体现各行业需求尚存在很大的不足，需要大量二次
开发才可满足，这点使 ERP-U8 很难做到普及。
1.3.2 二次开发现存问题
二次开发人员在参与 U8 的二次开发时主要存在以下问题：
1. 技术多样：就目前我了解的，U8 的二次开发采用了多种工具，多种开种
语言，例如 VB、Dephil
2. 集成性差，没有 U8 原有的产品不能很好的集成，主要体现在与标准产品
的界面风格，基本功能不一致
3. 获得帮助少，二次开发人员在进行 U8 的二次开发时，往往需要自己研究
U8 标准产品的用法，遇到一些问题也无法得到及时的解答，只能在摸索
中前进，这样导致开发的效率时常比较低下
4. 对于 U8 标准控件的使用不全面，相对局限性，二次开发人员在使用 U8
标准控件时，通常是只知道其一，不知道其二，许多标准控件中的功能
没能及时应用上，这与 U8 标准控件没有形成一个全面的帮助有关。
1.4 编写目的
本手册主要是描述我在进行 U8 二次开发的过程中一些经验与体会，包括对 U8 标准控
件的使用以及一些问题的排错，在后续的开发中会逐渐完善该文档。
2 控件使用
2.1 开发环境
开发详述：
开发工具：VB+SQL SERVER2000
操作系统：windows2000;windows xp pro;windows 2003 (建议使用 windows2003)
U8 版本：U870+SP1
2.2 单据控件
2.2.1 如何使单据自定义项根据用户的需求弹出参照
用户在使用U8的过程中可能需要根据自己业务需求启用U8的单据的自定义
项为自己的单据添加一些业务参照，这就需要开发人员在开发过程中注意把调用
系统自定义项的代码添加进去。
2.2.1.1 组件引用
部件引用：
注意：单据控件有两种，一种是 U860 中使用的，它们名字的区别是 870 的是
UAPVoucherControl85，而 860 的是 VoucherControl85，两个控件切忌一起引入，不然会有冲
突，程序无法识别。
DLL 引用：
图示中红色标注的是较为重要的一些 DLL。
2.2.1.2 参考代码段：
要使新做的单据支持单据的自定义项需要在代码中添加以下代码：
第一步：'基础档案、单据参照统一过程
Public Sub BaseBillRef(moRef As Object, vis As clsItemState, sRet As Variant)
Dim Rst As ADODB.Recordset
Dim strGrid As String, _
strFld As String, _
strChn As String, _
strWid As String, _
strTab As String
If vis.nDataSource = 1 Then '参照基础档案
（sDataRule=department，cdepcode）
If moRef.EnumRefInit(g_oLogin, enuTreeViewAndGrid, False,
Left$(vis.sDataRule, InStr(1, vis.sDataRule, ",") - 1)) = False Then Exit Sub
strFld = Mid(vis.sDataRule, InStr(1, vis.sDataRule, ",") + 1)
ElseIf vis.nDataSource = 2 Then '参照单据档案
（sDataRule=17，csocode）17 为 cardnumber
strTab = GetBillRefString(Left$(vis.sDataRule, InStr(1, vis.sDataRule, ",") - 1),
strGrid, strChn, strWid, False)
If strTab = "" Then Exit Sub
'返回值列没有显示，则补充。
If InStr(1, LCase(strGrid), LCase(Mid(vis.sDataRule, InStr(1, vis.sDataRule, ",") +
1))) <= 0 Then
strGrid = strGrid & "," & Mid(vis.sDataRule, InStr(1, vis.sDataRule, ",") + 1)
strChn = strChn & ",隐藏列"
strWid = strWid & ",0"
End If
strGrid = strGrid & " from " & strTab
If moRef.StrRefInit_SetColWidth(g_oLogin, False, "", strGrid, strChn, strWid) =
False Then Exit Sub
strFld = Mid(vis.sDataRule, InStr(1, vis.sDataRule, ",") + 1)
End If
'统一赋值
moRef.Show: Set Rst = moRef.recmx
If Rst Is Nothing Then Exit Sub
sRet = Rst(strFld)
End Sub
第二步：以下代码是上述代码中 GetBillRefString 函数：
'获取单据参照参数 GetBillRefString
Public Function GetBillRefString(ByVal strCardNum As String, _
strSelFldLst As String, _
strChnFldLst As String, _
strColWidLst As String, _
ByVal bOnlyTab As Boolean) As String
Dim strSql As String
Dim strTab As String
Dim Rst As ADODB.Recordset
GetBillRefString = ""
strSql = "select BTTblName from vouchers where cardnumber='" & strCardNum & "'"
Set Rst = gConn.Execute(strSql)
If Rst.EOF Or Rst.BOF Then Exit Function
strTab = Rst(0)
If bOnlyTab Then
GetBillRefString = strTab
Exit Function
End If
strSelFldLst = "Select "
strSql = "select fieldname,(case when cardformula1='' then (case when cardformula2=''
then carditemname else cardformula2 end) else cardformula1 end) as chnname from voucheritems
where cardnum='" & strCardNum & "' and cardsection='T' and Showit=1 and TableName='" &
strTab & "'"
Set Rst = gConn.Execute(strSql)
If Rst.EOF Or Rst.BOF Then Exit Function
Do While Not Rst.EOF
strSelFldLst = strSelFldLst & Rst!FieldName & ","
strChnFldLst = strChnFldLst & Trim(Rst!chnname) & ","
strColWidLst = strColWidLst & "1500,"
Rst.MoveNext
Loop
strSelFldLst = Left(strSelFldLst, Len(strSelFldLst) - 1)
strChnFldLst = Left(strChnFldLst, Len(strChnFldLst) - 1)
strColWidLst = Left(strColWidLst, Len(strColWidLst) - 1)
GetBillRefString = strTab
End Function
第三步：当添加一个单据的参照之后，要添加基础档案的检测：
'基础档案、单据检查统一过程
Public Function BaseBillChk(vis As clsItemState, RetValue As Variant, bChanged As
UAPVoucherControl85.CheckRet) As Boolean
Dim strSql As String, _
strTab As String
Dim Rst As ADODB.Recordset
BaseBillChk = False
If Trim(RetValue) = "" Then
RetValue = Trim(RetValue)
bChanged = success
BaseBillChk = True
Exit Function
End If
If vis.nDataSource = 1 Then '参照基础档案
（sDataRule=department，cdepcode）
strSql = "select 1 from " & Left$(vis.sDataRule, InStr(1, vis.sDataRule, ",") - 1) & "
where " & Mid(vis.sDataRule, InStr(1, vis.sDataRule, ",") + 1) & "='" & RetValue & "'"
Set Rst = gConn.Execute(strSql)
If Rst.EOF Or Rst.BOF Then
MsgBox "输入的档案项不存在!", vbInformation
bChanged = Cancel
Exit Function
End If
ElseIf vis.nDataSource = 2 Then '参照单据档案
（sDataRule=17，csocode）17 为 cardnumber
strTab = GetBillRefString(Left$(vis.sDataRule, InStr(1, vis.sDataRule, ",") - 1), "", "",
"", True)
If strTab = "" Then
MsgBox "单据不存在!", vbInformation
bChanged = Cancel
Exit Function
End If
strSql = "select 1 from " & strTab & " where " & Mid(vis.sDataRule, InStr(1,
vis.sDataRule, ",") + 1) & "='" & RetValue & "'"
Set Rst = gConn.Execute(strSql)
If Rst.EOF Or Rst.BOF Then
MsgBox "输入的单据项不存在!", vbInformation
bChanged = Cancel
Exit Function
End If
End If
BaseBillChk = True
End Function
第四步：在单据的参照事件内添加以下代码（判断是何种类型）红字部分：
'自定义参照
'bill 单据对象
'r 0 表示表头参照，非 0 表示表体参照的当前行号。
'vis 表头或表体项目信息对象
'sRet 参照返回值
Public Sub Bus_BrowUser(Bill As Object, ByVal r As Long, vis As clsItemState, sRet As Variant)
Dim Rst As ADODB.Recordset
Dim strGrid As String
Dim strFld As String
Dim Rs As ADODB.Recordset
Dim sql As String
On Error GoTo errHandle
If r = 0 Then '表头参照
If vis.nDataSource = 0 Then '业务需要的参照
'这里面添加业务需要的用户自己编写的参照代码
Else
BaseBillRef reRef, vis, sRet '系统预设的参照（单据表头自定义项）
End If
Else
If vis.nDataSource = 0 Then '判断 vis 的值判断是何种业务的参照
'这里面添加业务需要的用户自己编写的参照代码
Else
BaseBillRef reRef, vis, sRet '系统预设的参照
End If
End If
Exit Sub
errHandle:
MsgBox Err.Description
End Sub
第五步：添加数据检测，把相关代码加入单据的检测事件中（红色部分）：
'有效性检查
'bill 单据对象
'RetValue 当前值
'bChanged 检查结果取消或重试或成功
'r 0 表示表头检查，非 0 表示表体检查的当前行号。
'vis 表头或表体项目信息对象
Public Sub Bus_CellCheck(Bill As Object, RetValue As Variant, bChanged As Long, ByVal r As
Long, vis As clsItemState)
Dim Rst As ADODB.Recordset
Dim strSql As String
Dim sql As String
Dim Rs As ADODB.Recordset
On Error GoTo errHandle
If r = 0 Then '表头
If vis.nDataSource = 0 Then '业务需要的检查
'用户自己编写的参照的检测
Else
If BaseBillChk(vis, RetValue, bChanged) = False Then Exit Sub '系统预设的检查
End If
Else
If vis.nDataSource = 0 Then '业务需要的检查
'用户自己编写的参照的检测
Else
If BaseBillChk(vis, RetValue, bChanged) = False Then Exit Sub '系统预设的检查
End If
End If
ExtOK:
bChanged = CheckRet.success
Exit Sub
errHandle:
MsgBox Err.Description
End Sub
2.2.1.3 系统设置
当完成了以上工作之后，用户就可以第六步的设置完成自己定义的项目。
进入系统的节点 -基础设置——基础档案设置——其它：进入自定义项档案设置
设置自定义项：
完成了之后，到单据格式中设置单据体就行了具体操作如下：
自定义项属性设置：
注意：如果要使用在单据格式设置界面可以进行参照类型的设置，开发人员在开发单据时，
使用单据设置单据模板时要注意在自定义项目设置为 1：
2.2.2 库存单据 USER-PCO 控件的使用
2.2.2.1 U870 准备工作、组件引用
二次开发人员在进行 USER-PCO 的使用之前，要在 VB 的工程引用中，引入该 DLL：
2.2.2.2 函数接口说明
新增单据- Insert 函数
参数：
VoucherType —— 单据类型，对应 VouchType 表中的 cVouchType 字段
Header —— 表头 DOM 对象
Body —— 表体 DOM 对象
Position —— 货位 DOM 对象
ErrMsg —— 错误信息
ConnFrom —— 连接对象
VoucherId —— 单据 ID
DOMMsg —— 超可用量提示信息 DOM 对象
Check —— 是否进行业务检查
BeforCheckStock —— 是否检查可用量
IsRedVouch —— 是否红字单据
ReMote —— 是否远程
删除单据-Delete 函数
参数：
VoucherType —— 单据类型，对应 VouchType 表中的 cVouchType 字段
VoucherId —— 单据 ID
ErrMsg —— 错误信息
ConnFrom —— 连接对象
TimeStamp —— 单据时间戳
DOMMsg —— 超可用量提示信息 DOM 对象
Check —— 是否进行业务检查
BeforCheckStock —— 是否检查可用量
修改单据-Update 函数
参数：
VoucherType —— 单据类型，对应 VouchType 表中的 cVouchType 字段
Header —— 表头 DOM 对象
Body —— 表体 DOM 对象
Position —— 货位 DOM 对象
ErrMsg —— 错误信息
ConnFrom —— 连接对象
VoucherId —— 单据 ID
DOMMsg —— 超可用量提示信息 DOM 对象
Check —— 是否进行业务检查
BeforCheckStock —— 是否检查可用量
IsRedVouch —— 是否红字单据
AddedState —— 修改状态
装载单据-Load 函数
参数：
VoucherType —— 单据类型，对应 VouchType 表中的 cVouchType 字段
Condition —— 条件串
Header —— 表头 DOM 对象
Body —— 表体 DOM 对象
Position —— 货位 DOM 对象
ErrMsg —— 错误信息
GetBlank —— 是否获取空白单据
BodyOrderBy —— 表体排序方式字段
审核单据-Audit 函数
参数：
VoucherType —— 单据类型，对应 VouchType 表中的 cVouchType 字段
VoucherId —— 单据 ID
ErrMsg —— 错误信息
ConnFrom —— 连接对象
TimeStamp —— 单据时间戳
DOMMsg —— 超可用量提示信息 DOM 对象
Check —— 是否进行业务检查
BeforCheckStock —— 是否检查可用量
弃审单据-CancelAudit 函数
参数：
VoucherType —— 单据类型，对应 VouchType 表中的 cVouchType 字段
VoucherId —— 单据 ID
ErrMsg —— 错误信息
ConnFrom —— 连接对象
TimeStamp —— 单据时间戳
DOMMsg —— 超可用量提示信息 DOM 对象
Check —— 是否进行业务检查
BeforCheckStock —— 是否检查可用量
2.2.2.3 参考代码（Insert 方法）
1. 使用该函数，二次开发人员还得对存货的可用量进行判断以及获取系统的设置，看是否
设置了可超可用量发货，然后设置相应的是否检查业务与是否检查可用量，参考代码如下：
'*****************************
'判断是否进行可用量的检查 *
'by 王冬冬 2007-11-29 *
'*****************************
Public Function CheckKQty() As Boolean
Dim bNoBatch As Boolean
Dim bYesBatch As Boolean
Dim strSql As String
Dim rs As New ADODB.Recordset
'查询表体的存货是否存在非批次管理的
strSql = "select * from HY_FZ_SendMaterialOrder_details inner join inventory on
HY_FZ_SendMaterialOrder_details.cInvCode=inventory.cInvCode where bInvBatch=0 and id='"
& Voucher.headerText("ID") & "'"
rs.Open strSql, g_Conn, 1, 1
If rs.RecordCount > 0 Then
bNoBatch = True '存在非批次管理标志
Else
bNoBatch = False '不存在非批次管理标志
End If
rs.Close
'查询表体的存货是否存在批次管理
strSql = "select * from HY_FZ_SendMaterialOrder_details inner join inventory on
HY_FZ_SendMaterialOrder_details.cInvCode=inventory.cInvCode where bInvBatch=1 and id='"
& Voucher.headerText("ID") & "'"
rs.Open strSql, g_Conn, 1, 1
If rs.RecordCount > 0 Then
bYesBatch = True '存在批次管理标志
Else
bYesBatch = False '不存在批次管理标志
End If
rs.Close
'当表体存货中两种类型存货都存在，则必须检查两种设置
If bNoBatch = True And bYesBatch = True Then
strSql = "select cValue from AccInformation where cSysID='ST' and
cName='bAllowZero' or cName='bBatchAllowZero'"
rs.Open strSql, g_Conn, 1, 1
If LCase(rs.Fields("cValue")) = "true" Then
rs.MoveNext
If LCase(rs.Fields("cValue")) = "true" Then
CheckKQty = False
Else
CheckKQty = True
End If
Else
CheckKQty = True
End If
rs.Close
'当表体只存在批次管理存货，则检查批次管理的存货是否允许超可用量出货
ElseIf bNoBatch = False And bYesBatch = True Then
strSql = "select cValue from AccInformation where cSysID='ST' and
cName='bBatchAllowZero'"
rs.Open strSql, g_Conn, 1, 1
If LCase(rs.Fields("cValue")) = "true" Then
CheckKQty = False
Else
CheckKQty = True
End If
rs.Close
'当表体只存在非批次管理存货，则检查非批次管理的存货是否允许超可用量出货
ElseIf bNoBatch = True And bYesBatch = False Then
strSql = "select cValue from AccInformation where cSysID='ST' and
cName='bAllowZero'"
rs.Open strSql, g_Conn, 1, 1
If LCase(rs.Fields("cValue")) = "true" Then
CheckKQty = False
Else
CheckKQty = True
End If
rs.Close
End If
End Function
该函数返回是否检查业务与可用量的标志值
2. 然后就开始对 USER-PCO 进行使用配置。（参考代码）
Public Function CreateOut(HTable As String, BTable As String) As Boolean
Dim sql As String, sSql As String
Dim rs As ADODB.Recordset
Dim sID As String
Dim sSource As String
Dim odomhead As New DOMDocument
Dim sDomHead As New DOMDocument
Dim odombody As New DOMDocument
Dim sDombody As New DOMDocument
Dim node As IXMLDOMElement
Dim aNode As IXMLDOMElement
Dim oDomPosition As DOMDocument
Dim eleHead As IXMLDOMElement
Dim seleHead As IXMLDOMElement
Dim eleBody As IXMLDOMElement
Dim seleBody As IXMLDOMElement
Dim sNode As IXMLDOMNode
Dim oNode As IXMLDOMNode
Dim cinvcode As String
Dim cinname As String
Dim color As String
Dim size As String
Dim pmMatch As String
Dim errMsg As String
Dim Flag As Boolean
Dim bCheck As Boolean
'检查是否进行可用量检查
bCheck = CheckKQty
'构建表头 XML,对应于主表 RdRecord
sql = "Select * From RecordOutQ where 1=2"
Set rs = g_Conn.Execute(sql)
rs.Save odomhead, adPersistXML
rs.Close
sSql = "Select * From " & HTable 'HTable 为单据数据主表
Set rs = g_Conn.Execute(sSql)
rs.Save sDomHead, adPersistXML
rs.Close
Set seleHead = sDomHead.selectSingleNode("//z:row")
Set eleHead = odomhead.selectSingleNode("//rs:data")
eleHead.appendChild seleHead
' Set eleHead = oDomhead.selectSingleNode("//z:row")
'eleHead.setAttribute "cCode", GetMaxValue(HTable, "cCode")
'构建表体 XML,对应于表 RdRecords
sSql = "Select * From RecordOutsQ where 1=2"
Set rs = g_Conn.Execute(sSql)
rs.Save odombody, adPersistXML
rs.Close
sSql = "Select * From " & BTable 'BTable 为单据数据子表
Set rs = g_Conn.Execute(sSql)
rs.Save sDombody, adPersistXML
rs.Close
Set sNode = sDombody.selectSingleNode("//rs:data")
Set oNode = odombody.selectSingleNode("//rs:data")
oNode[xss_clean].appendChild sNode
Set oNode = odombody.selectSingleNode("//rs:data")
oNode[xss_clean].removeChild oNode
Dim objPco As New USERPCO.VoucherCO
Dim a As Object
If g_oLogin.LoginEx("ST", a) = False Then
MsgBox "无法登陆库存子系统，无法删除单据！"
Exit Function
End If
Call objPco.IniLogin(g_oLogin, sSource)
Dim ErDom As DOMDocument
Flag = objPco.Insert("11", odomhead, odombody, oDomPosition, sSource, , sID, ErDom,
bCheck, bCheck)
'下面对超可用量进行判断，解析
If Flag = False And sSource = "" Then
Set node = ErDom.selectSingleNode("//zeroout")
For Each aNode In node.selectNodes("//z:row")
cinvcode = CStr(aNode.getAttributeNode("cinvcode").Value)
cinvname = CStr(aNode.getAttributeNode("cinvname").Value)
color = CStr(aNode.getAttributeNode("cfree1").Value)
size = CStr(aNode.getAttributeNode("cfree2").Value)
pmMatch = CStr(aNode.getAttributeNode("cfree3").Value)
errMsg = errMsg & "存货编码：" & cinvcode & " 存货名称：" & cinvname & "
颜色：" & color & " 尺码：" & size & " 配码：" & pmMatch & vbCrLf
Next
MsgBox errMsg & vbCrLf & "以上信息的产品超可用量出库，生单失败 ",
vbInformation, "生单失败!"
CreateOut = False
Exit Function
ElseIf sSource <> "" Then
MsgBox sSource, vbInformation, "生单失败"
CreateOut = False
Exit Function
Else
'返写生成的单据号
g_Conn.Execute " update HY_FZ_SendMaterialOrder_main set outcode=(select ccode
from rdrecord where id=" & sID & "),outid = " & sID & " ,vouchtypename = '材料出库单'
where id=" & Voucher.headerText("id")
MsgBox "生单成功！", vbInformation, "提示"
CreateOut = True
ExecRefresh
End If
End Function
2.2.3 单据标准（排序、合并、批改等功能）
（注：单据标准说明由徐燕编写以及提供资料，特此致谢）
U8 标准产品单据控件集合了很多好的应用，给用户的操作带来很大
的便利性，这里列举几种常见的应用：合并显示、表体定位、表体排
序、批量修改、打印、输出，帮助
2.2.3.1 合并显示
参数说明 ：vch 单前操作单据对象
变量说明：g_oLogin 登陆对象
Public Sub ExecShowAgg(vch as ctlVoucher) '合并显示
On Error GoTo errHandle
vch.ProtectUnload2
Dim m_oDataSource As Object
Set m_oDataSource = CreateObject("IDataSource.DefaultDataSource")
If m_oDataSource Is Nothing Then
MsgBox "无法创建 m_oDataSource 对象!", vbExclamation
Exit Sub
End If
Set m_oDataSource.SetLogin = g_oLogin
Set vch.SetDataSource = m_oDataSource
vch.SHowAggregateSetupDlg
Exit Sub
errHandle:
DefineMsgBox Err.Description + "，表体行处理失败！"
End Sub
注：合并显示在 U872 以上版本还添加以 CHECKBOX 方式勾选是否合并显示具体实现如下：
在单据加载模板之前调用：
Voucher.ShowSummaryView=True
2.2.3.2 表体定位
调用单据自身函数：Voucher.ShowFindDlg
2.2.3.3 表体排序
（1） 在 form_load 中设置 Voucher.ShowSorter = True
2.2.3.4 批量修改
'参数说明 ：vch 单前操作单据对象
'变量说明：g_oLogin 登陆对象
Public Sub ExecBathModify(vch As ctlVoucher) '批量修改
On Error GoTo errHandle
Dim m_oDataSource As Object
Set m_oDataSource = CreateObject("IDataSource.DefaultDataSource")
If m_oDataSource Is Nothing Then
MsgBox "无法创建 m_oDataSource 对象!", vbExclamation
Exit Sub
End If
Set m_oDataSource.SetLogin = g_oLogin
Set vch.SetDataSource = m_oDataSource
vch.ShowBatchModify
Exit Sub
errHandle:
DefineMsgBox Err.Description + "，表体行处理失败！"
End Sub
2.2.3.5 打印
'参数说明：
'oConnection (ADODB.Connection) 数据库连接对象
'oVoucher (ctlVoucher) 单据对象
'sBillNumber (String) 单据号
'sTemplateID (String) 模板号
'bPreview [Boolean, False] 标志是否显示预览界面
Public Sub VoucherPrint( _
ByRef oConnection As ADODB.Connection, _
ByRef oVoucher As ctlVoucher, _
ByVal sBillNumber As String, _
ByVal sTemplateID As String, _
Optional ByVal bPreview As Boolean = False)
Dim oField As ADODB.Recordset ' 固定文本数据
Dim oTemplate As ADODB.Recordset ' 单据模板数据
Dim oVoucherTemplate As UFVoucherServer85.clsVoucherTemplate
Dim sError As String
Dim oDomhead As DOMDocument
Dim oDombody As DOMDocument
Set oVoucherTemplate _
= CreateObject("UFVoucherServer85.clsVoucherTemplate")
If oVoucherTemplate Is Nothing Then
MsgBox "创建模板对象失败。", vbCritical
GoTo Exit_Label
End If
Set oTemplate = oVoucherTemplate.GetTemplateData2( _
Conn:=oConnection, _
sBillName:=sBillNumber, _
vTemplateID:=sTemplateID)
Set oField = oVoucherTemplate.GetFixedData( _
Conn:=oConnection.ConnectionString, _
vVtid:=sTemplateID)
Call oVoucher.PrintVoucher( _
rsTemplate:=oTemplate, _
rsField:=oField, _
bShowPrintViewDlg:=bPreview)
Exit_Label:
On Error GoTo 0
Set oDomhead = Nothing
Set oDombody = Nothing
Set oVoucherTemplate = Nothing
If Not oField Is Nothing Then
If oField.state = adStateOpen Then _
Call oField.Close
End If
Set oField = Nothing
If Not oTemplate Is Nothing Then
If oTemplate.state = adStateOpen Then _
Call oTemplate.Close
End If
Set oTemplate = Nothing
End Sub
2.2.3.6 输出
'导出单据单据数据到指定的文件
'参数说明：
'oConnection (ADODB.Connection) 数据库连接对象
'oVoucher (ctlVoucher) 单据对象
'sBillNumber (String) 单据号
'sTemplateID (String) 模板号
Public Sub ExportVoucherData2File( _
ByRef oConnection As ADODB.Connection, _
ByRef oVoucher As ctlVoucher, _
ByVal sBillNumber As String, _
ByVal sTemplateID As String)
Dim oField As ADODB.Recordset ' 固定文本数据
Dim oTemplate As ADODB.Recordset ' 单据模板数据
Dim oVoucherTemplate As Object
'On Error GoTo Err_Handler
Set oVoucherTemplate _
= CreateObject("UFVoucherServer85.clsVoucherTemplate")
If oVoucherTemplate Is Nothing Then
MsgBox "创建模板对象失败。", vbCritical
GoTo Exit_Label
End If
Set oTemplate = oVoucherTemplate.GetTemplateData2( _
Conn:=oConnection, _
sBillName:=sBillNumber, _
vTemplateID:=sTemplateID)
Set oField = oVoucherTemplate.GetFixedData( _
Conn:=oConnection.ConnectionString, _
vVtid:=sTemplateID)
Call oVoucher.ExportToFile( _
rsTemplate:=oTemplate, _
rsField:=oField)
Exit_Label:
On Error GoTo 0
Set oVoucherTemplate = Nothing
If Not oField Is Nothing Then
If oField.state = adStateOpen Then _
Call oField.Close
End If
Set oField = Nothing
If Not oTemplate Is Nothing Then
If oTemplate.state = adStateOpen Then _
Call oTemplate.Close
End If
Set oTemplate = Nothing
End Sub
2.2.4 单据参照的调用
2.2.4.1 单据定义参照调用方法
2.2.4.1.1 组件引用
参照服务：
2.2.4.1.2 参考代码
Private hwRef As New UFReferC.UFReferClient '声明一个参照服务客户端的对象
'自定义参照
'Bill 单据对象
'vis 表头或表体项目信息对象
'sRet 参照返回值
Public Sub Bus_BrowUser(Bill As Object, ByVal r As Long, ByVal C As Long, sRet As
Variant)
Dim rst As ADODB.Recordset
Dim strGrid As String
Dim strFld As String
Dim strRet As String
Dim sField As String
InvCodePos = Bill.GetColIndex(cInvCode)
InvNamePos = Bill.GetColIndex(cInvName)
colorPos = Bill.GetColIndex(color)
sizePos = Bill.GetColIndex(size)
BCodePos = Bill.GetColIndex(BCode)
PartIdPos = Bill.GetColIndex(PartID)
cInvDefinePos = Bill.GetColIndex(cInvDefinePos)
On Error GoTo errHandle
sField = Bill.GetColName(C)
Select Case sField
Case cInvCode
If hwRef.EnumRefInit(g_oLogin, enuTreeViewAndGrid, False, DataType.enuStockInven) =
False Then Exit Sub '调用系统封装好的参照 （DataType）
strFld = "cInvCode"
Case color, size
If Bill.TextMatrix(r, InvCodePos) = "" Then
MsgBox "请先选择产品！", , "提示"
Exit Sub
Else
strGrid = "select partid,InvCode,cInvName,Free1,Free2 from
V_DetailInventory where invcode ='" & Bill.TextMatrix(r, InvCodePos) & "'"
If hwRef.StrRefInit_SetColWidth(g_oLogin, False, "", strGrid, "序列号,产品
编码,产品名称,颜色,尺码", "1500,1500") = False Then Exit Sub '采用 SQL 语句自定义参照
strFld = IIf(sField = color, "Free1", "Free2")
End If
End Select
hwRef.Show: Set rst = hwRef.recmx '显示参照
If rst Is Nothing Then Exit Sub
sRet = rst(strFld)
'todo 设置联动
Select Case sField
Case cInvCode
Bill.TextMatrix(r, C) = rst!cInvCode & ""
Bill.TextMatrix(r, InvNamePos) = rst!cInvName & ""
' Bill.TextMatrix(R, cInvDefinePos) = rst!cInvDefine10 & ""
Case color, size
Bill.TextMatrix(r, colorPos) = rst!Free1 & ""
Bill.TextMatrix(r, sizePos) = rst!Free2 & ""
End Select
Exit Sub
errHandle:
DefineMsgBox err.Description
End Sub
2.2.4.2 调用 UAP 设计好的系统参照（一）
使用这个 UAP 设计好的系统参照同样需要引入参照服务的同样的 DLL
参考代码：
Private Sub Voucher_headBrowUser(ByVal Index As Variant, sRet As Variant, referPara As
UAPVoucherControl85.ReferParameter)
Dim vis As UAPVoucherControl85.clsItemState
Set vis = Voucher.ItemState(Index, 0)
Dim strRefTable As String
Dim sqlstr As String
Dim color As String
Dim rs As New ADODB.Recordset
Dim rst As ADODB.Recordset
Dim strGrid As String
Dim strFld As String
Dim sHeadItemName As String
Dim RefRs As ADODB.Recordset
Dim i, j As Long
Dim sMetaXML As String
sMetaXML = "<Ref><RefSet bAuth='0' /></Ref>"
On Error GoTo errHandle
moRef.SetLogin g_oLogin
sHeadItemName = LCase(Voucher.ItemState(Index, siheader).sFieldName)
'部门参照
If sHeadItemName = "deptcode" Then
strFilterSQL = ""
referPara.ReferMetaXML = sMetaXML
referPara.ID = "Department_AA"
referPara.sSql = strFilterSQL
End If
'业务员参照
If sHeadItemName = "busyman" Then
strFilterSQL = ""
referPara.ReferMetaXML = sMetaXML
referPara.ID = "Person_AA"
referPara.sSql = strFilterSQL
End If
'仓库参照
If sHeadItemName = "inwarehouse" Or sHeadItemName = "outwarehouse" Then
strFilterSQL = ""
referPara.ReferMetaXML = sMetaXML
referPara.ID = "Warehouse_AA"
referPara.sSql = strFilterSQL
End If
'出库类型
If sHeadItemName = "crdcode" Then
strFilterSQL = "bRdFlag=0 and bRdEnd=1"
referPara.ReferMetaXML = sMetaXML
referPara.ID = "Rd_Style_ST"
referPara.sSql = strFilterSQL
End If
Exit Sub
errHandle:
MsgBox Err.Description, , "提示"
End Sub
注意：在使用这种方式需要在使用该功能前设置数据源（建议放在 FORM 的 LOAD 事件内），
参考代码：
'加载计划单数据来源
Set oDataSource = CreateObject("IDataSource.DefaultDataSource")
If oDataSource Is Nothing Then
MsgBox "创建单据数据源对象 Fail!", vbExclamation
End If
Set oDataSource.SetLogin = g_oLogin
ctlVoucher2.LoginObj = g_oLogin
ctlVoucher2.InitDataSource
2.2.4.3 调用 UAP 设计好的系统参照（二）标准产品使用
组件调用：参照服务的服务器端
参考代码：（该代码支持多选）
'采用新方式调用系统参照
'编写者：王冬冬
Private Sub Voucher_bodyBrowUser(ByVal Row As Long, ByVal Col As Long, sRet As Variant,
referPara As UAPVoucherControl85.ReferParameter)
Dim vis As UAPVoucherControl85.clsItemState
'使用新的参照服务
Dim objRefer As New U8RefService.IService '定义参照服务服务端
Set vis = Voucher.ItemState(Col, 1) '记住此处，是关键
Dim sqlstr As String
Dim rstClass As New ADODB.Recordset
Dim rstGrid As New ADODB.Recordset
Dim ErrMsg As String
Dim sBodyItemName As String
Dim sMetaXML As String
'这句重要，将参照事件设置为不启动状态
referPara.Cancel = True
'设置参照是否多选
sMetaXML = "<Ref><RefSet bAuth='0' bMultiSel= '1' /></Ref>"
moRef.SetLogin g_oLogin
sBodyItemName = LCase(Voucher.ItemState(Col, sibody).sFieldName)
If sBodyItemName = "cinvcode" Then
objRefer.RefID = "Inventory_AA"
objRefer.MetaXML = sMetaXML
'下面代码是调用参照服务（U8 标准产品）
If objRefer.ShowRef(g_oLogin, rstClass, rstGrid, ErrMsg) = False Then Exit Sub
If rstGrid Is Nothing Then Exit Sub
Dim rr As Long, AddNewLn As Boolean
Dim temp As String
'判断弹出的参照是否有选择或者选择取消按钮
If rstGrid.state = 0 Then Exit Sub
sRet = rstGrid("cinvcode")
rr = 0
'下列函数是对多选的数据进行处理
AddNewLn = (Voucher.Row = Voucher.bodyRows)
If rstGrid.RecordCount > 1 And Voucher.Row < Voucher.bodyRows Then
AddNewLn = (MsgBox("是否把选定存货追加到最后吗？" & Chr(13) & _
"选是将修改当前行,并把其余记录追加到最后！" & Chr(13) & _
"选否将从当前行开始覆盖！", vbYesNo + vbQuestion, "请选择编辑方
式") = vbYes)
End If
While rstGrid.EOF = False
If rr = 0 Then
Voucher.bodyText(Row + rr, "cinvcode") = rstGrid("cinvcode")
temp = rstGrid("cinvcode")
Fun.Bus_CellCheck Voucher, rstGrid("cinvcode"), 2, Row + rr, vis
Else
If AddNewLn Then
If Voucher.BodyRowIsEmpty(Voucher.bodyRows) = False Then
Voucher.AddLine Voucher.bodyRows + 1
Voucher.bodyText(Voucher.bodyRows - 1, "cinvcode") = temp
End If
Voucher.UpdateLineData Voucher.GetLineDom(r), Voucher.bodyRows
Voucher.bodyText(Voucher.bodyRows,"cinvcode") = rstGrid("cinvcode")
temp = rstGrid("cinvcode")
Fun.Bus_CellCheck Voucher, rstGrid("cinvcode"), 2, Voucher.bodyRows, vis
Else
Voucher.bodyText(Row + rr, "cinvcode") = rstGrid("cinvcode")
temp = rstGrid("cinvcode")
Fun.Bus_CellCheck Voucher, rstGrid("cinvcode"), 2, Row + rr, vis
End If
End If
rstGrid.MoveNext
rr = rr + 1
Wend
Exit Sub
End If
End Sub
2.2.5 单据打印标准化
单据打印标准化指二次开发出来的单据拥有与 U8 标准单据相一致的打印、
输出、预览。U8 单据打印包含两方面内容：
（1） 打印格式设置：
打印格式设置，需要使用单据标准事件：SaveSettingEvent
Private Sub Voucher_SaveSettingEvent(ByVal varDevice As Variant)
Dim TmpUFTemplate As Object
Set TmpUFTemplate = CreateObject("UFVoucherServer85.clsVoucherTemplate")
If TmpUFTemplate.SaveDeviceCapabilities(g_Conn.ConnectionString,
m_strVT_PRN_ID, varDevice) <> 0 Then
MsgBox "U8.SA.xsglsql.01.frmbillvouch.00361", vbInformation,
MapResidToString("U8.FZ.HY_FZ_ProSendMaterial.frm040") 'zh-CN：打印设置
保存失败
End If
End Sub
（2） 打印次数、打印密码控制：
打印次数、打印密码控制指在 U8 系统——基础设置——单据设置—
—单据打印控制中可设置相应单据的打印次数与打印密码。
具体实现如下：
将单据注册表内 VOUCHERS_BASE 的 IsPrintLimited 字段设置为 1
例如：
update VOUCHERS_BASE set IsPrintLimited =1 where cardnumber='FZ0205001'
2.3 单据列表控件
2.3.1 单据列表输出功能
在参与二次开发的途中，我发现二次开发的单据列表对输出功能都没有进行使用前设
置，导致在使用该单据列表的输出功能时，造成系统崩溃。
大家都清楚，使用单据列表输出功能只需调用单据列表控件的 PrintToFile 函数，但是在
使用该函数之前，要进行一个单据类表模板的设置才能正确输出：
对齐方式的设置（一般二次开发人员很少设置该项目）：
注意：二次开发人员如果要使用该控件的输出功能，请务必设置该对齐方式。如果不设置该
对齐方式会造成 U8 的异常退出。
2.3.2 单据列表的分页功能
2.3.2.1 组件引用
部件引用：
DLL 引用：
2.3.2.2 概述
单据列表的分页功能，二次开发人员是不需要自己设计的，只需要调用 U8
原标准产品的分页控件即可，效果展示：
2.3.2.3 功能实现
二次开发人员在引入单据列表控件部件时，在部件显示栏中会同时出现一个名叫——
pageDivCtl 的控件，单据列表的分页功能就是使用该控件，下面有详细的代码参考：
声明一些必要的变量（红色重要）：
Public objColset As U8ColumnSet.clsColSet
'常量
Private Const strVOUCH_KEY As String = "FZ0205001"
Private Const strDBVName As String = "v_HY_FZ_SendMaterialOrder_main"
Private objListRec As ADODB.Recordset
Dim recclass As New ADODB.Recordset
Private WithEvents m_pagediv As Pagediv '分页
Private m_coni As IPagedivConi '条件，基本上都是从 U8Colset 中进行初始化
Public vchVoucher As ctlVoucher
Dim m_bshowSumType As Boolean '是否汇总显示
'窗体加载函数：
Private Sub Form_Load()
On Error GoTo ErrorHandler
CurOpStatus = SHOW_ALL
Set UFToolbar1.Business = g_obusiness
init_UFtoolbar
'调整控件布局
Call FormLayout
'初始化表体
Call InitList
'填充数据
Set m_pagediv = New Pagediv '设置新的分页对象
Me.VouchList1.AdJustGridWidth
VouchList1.SumStyle = vlGridSum
' GetDatas
' LoadHelpId ("12250036")
ExecLocal
Exit Sub
ErrorHandler:
DefineMsgBox "错误号：" & Err.Number & "错误描述：" & Err.Description
End Sub
重要是下一函数：
'获得数据
Private Sub GetDatas()
Dim strwhere As String
Me.VouchList1.SetVchLstRst Nothing
Me.VouchList1.FillMode = FillAppend
If bFilter = True Then
strwhere = "ID in " & lngVoucherID
Else
strwhere = ""
End If
InitConi strwhere
Call PagedivCtl1.BindPagediv(m_pagediv)
Call m_pagediv.Initialize(g_Conn, m_coni)
m_pagediv.LoadData
Me.VouchList1.AdJustGridWidth
VouchList1.SumStyle = vlGridSum
Exit Sub
Exit_Label:
If Not objListRec Is Nothing Then
If objListRec.state = adStateOpen Then objListRec.Close
End If
End Sub
'分页事件，在得到页数之前
Private Sub m_pagediv_BeforeGetCount()
VouchList1.FillMode = FillOverwrite
End Sub
'分页事件，在得到页数之后
Private Sub m_pagediv_BeforeGetCount()
VouchList1.FillMode = FillOverwrite
End Sub
'分页事件，得到数据
Private Sub m_pagediv_GetData(ByVal vltable As U8VouchList.VouchListTable)
VouchList1.SetVchLstRst vltable.DataRecordset
Set recclass = vltable.DataRecordset
VouchList1.SetSumRst vltable.SumRecordset
VouchList1.RecordCount = vltable.DataCount
End Sub
'分页事件，得到数据之后，设置列表
Private Sub m_pagediv_AfterGetData(rst As ADODB.Recordset, cnt As Long)
Me.VouchList1.InitHead objColset.getColInfo()
VouchList1.SumStyle = vlGridSum
End Sub
'分页控件的事件，当转页数时触发
Private Sub PagedivCtl1_BeforeSendCommand(cmdType As U8VouchList.UFCommandType,
pageSize As Long, pagecurrent As Long)
Me.VouchList1.SetVchLstRst Nothing
Me.VouchList1.FillMode = FillOverwrite
pagecurrent1 = pagecurrent
End Sub
'初始化分页条件
Private Sub InitConi(strwhere As String)
Dim i As Long
Dim s As String
If m_coni Is Nothing Then
Set m_coni = New DefaultPagedivConi
End If
m_coni.From = strDBVName '相当于 From 部分
objColset.setColMode (strVOUCH_KEY), 0
If m_bshowSumType Then
m_coni.SelectConi = Replace(objColset.GetSqlSumString, "''", "' '")
If strwhere = "" Then strwhere = "1=1"
m_coni.Where = strwhere & " " & objColset.GetSqlGroupString
m_coni.OrderID = objColset.GetOrderString
Else
m_coni.SelectConi = objColset.GetSqlString
m_coni.OrderID = objColset.GetOrderString
m_coni.Where = strwhere '相当于 where 部分
End If
End Sub
以上代码均是参考性代码，主要的流程就是按照这个流程走。
2.3.3 单据列表的定位功能（列表数据定位）
该功能比较简单只要设置单据列表一个函数：
VouchList1.Locate True
VouchList1 是单据列表控件的名称。
待续。。。。。。
上一篇
