Public Function newnumber(bhmc As String) As String
On Error Resume Next
'生成数据表
Dim dt As DataTable = DataTables("tbljczldjbh")
dt.LoadFilter = "[bhmc] =N'" & bhmc & "'"
dt.Load
If dt.DataRows.Count = 1 Then
Dim dtr As DataRow = dt.DataRows(0)
Dim djqzsy() As String = dtr("djqzsy").Split(";") ' 将单据前缀式样拆分成数组
Select Case djqzsy(0)
Case "日期"
If dtr("mqxl") < Format(Date.Today,djqzsy(1)) Then
dtr("mqxl") = Format(Date.Today, djqzsy(1))
dtr("mqxh") = 0
dtr.Save
dtr.Load
MessageBox.show("日期区段进入新的区间,流水号将复位")
Else
If dtr("mqxl") > Format(Date.Today,djqzsy(1)) Then
MessageBox.show("日期区段退回过去区间,将引起严重的系统错误!","警告", MessageBoxButtons.ok, MessageBoxIcon.Error)
newnumber = dtr("djqz") & Format(Date.Today,djqzsy(1)) & "err"
Return newnumber
End If
End If
If dtr("djylws") = 0 Then
newnumber = dtr("djqz") & Format(Date.Today,djqzsy(1)) & Right("00000000" & dtr("mqxh") + 1, dtr("djlsws"))
Else
newnumber = dtr("djqz") & Format(Date.Today,djqzsy(1)) & Right("00000000" & dtr("mqxh") + 1, dtr("djlsws")) & Right("000000",dtr("djylws"))
End If
Case "无"
If dtr("djylws") = 0 Then
newnumber = dtr("djqz") & Right("00000000" & dtr("mqxh") + 1, dtr("djlsws"))
Else
newnumber = dtr("djqz") & Right("00000000" & dtr("mqxh") + 1, dtr("djlsws")) & Right("000000", dtr("djylws"))
End If
End Select
dtr("mqxh") = dtr("mqxh") + 1
dtr.Save
Else
MessageBox.show("系统信息出错/提取代码有误","警告")
End If
End Function
3，生成新记录时，引用newnumber(bhmc As String) 过程，自动生成新单号
加好友 
发短信
Post By：2023/1/28 20:35:00 [只看该作者]
