金蝶VB插件--单据保存前检查

--转自https://bbs.csdn.net/topics/360161119?list=lz

vb代码

引用k3classEvents

'-----以下是代码
'实现一个很简单的功能
'--单据体分录[FBase字段]不能重复

'--在保存前判断
'--假设你已经会基础资料,单据界面的拖放,偶的开发环境是k3 12.1 标准版
'以下是代码
'--创建Active dll 工程
'--为了能调试代码
'--Project-->---Debugging-->--[Start Program]-->--里面选择kdMain.exe

Private WithEvents m_BillInterface As BillEvent

Const m_Module As String = "k3Test.clsTest_Bill"

Public Sub Show(obj As Object)
On Error GoTo ErrHandler
Set m_BillInterface = obj
Exit Sub
ErrHandler:
MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & m_Module & "_show"
End Sub

'--释放资源
Private Sub Class_Terminate()
Set m_BillInterface = Nothing
End Sub

'--单据保存前,校验单据体数据是否存在重复
Private Sub m_BillInterface_BeforeSave(bCancel As Boolean)
On Error GoTo ErrHandler
'--保存之前的事件
'单据体不允许有重复的记录
Dim iRow, iIndex, iTotalRow As Long
iTotalRow = m_BillInterface.BillEntrys(1).GridMaxDataRowNum
For iRow = iTotalRow To 1 Step -1 '从末尾开始删除数据
If Val(m_BillInterface.GetFieldValue("FBase", iRow)) = 0 Then '单据体有空白分录先清除
m_BillInterface.RemoveRow True, 2, iRow
End If
Next

iTotalRow = m_BillInterface.BillEntrys(1).GridMaxDataRowNum '重新获得单据体最大分录行数
For iRow = 1 To iTotalRow
For iIndex = iRow + 1 To iTotalRow
If Val(m_BillInterface.GetFieldValue("FBase", iRow)) = Val(m_BillInterface.GetFieldValue("FBase", iIndex)) Then '--如果检测到相同的记录，提示，不允许保存
MsgBox "单据体第" & iRow & "行和第" & iIndex & "行相同，不允许保存！", vbCritical, "错误"
Call m_BillInterface.SetActiveCell("FBase", iIndex) '--重复行设置焦点
bCancel = True '--不允许保存
Exit For
End If
Next
Next
Exit Sub
ErrHandler:
MsgBox Err.Number & vbCrLf & Err.Description & vbCrLf & m_Module & "_BeforeSave"
'--如果是中间层,使用 Err.Raise
End Sub