📄 frmvoucherno.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmvoucherNo
Caption = "凭证编号查询"
ClientHeight = 4410
ClientLeft = 45
ClientTop = 330
ClientWidth = 6285
LinkTopic = "Form1"
ScaleHeight = 4410
ScaleWidth = 6285
StartUpPosition = 2 '屏幕中心
Begin VB.ListBox lischa
Height = 3840
Left = 120
TabIndex = 9
Top = 420
Width = 4785
End
Begin VB.CommandButton CmdPrint
Height = 350
Left = 5010
Picture = "frmVoucherNo.frx":0000
Style = 1 'Graphical
TabIndex = 8
Top = 990
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOK
Default = -1 'True
Height = 345
Left = 5010
Picture = "frmVoucherNo.frx":087A
Style = 1 'Graphical
TabIndex = 7
Top = 480
UseMaskColor = -1 'True
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
Height = 24
Left = 3432
TabIndex = 6
Top = 2568
Width = 84
_ExtentX = 132
_ExtentY = 53
_Version = 65541
End
Begin VB.VScrollBar VSc2
Height = 252
Left = 2130
Max = 13
Min = 1
TabIndex = 5
Top = 90
Value = 5
Width = 204
End
Begin VB.VScrollBar VSc1
Height = 252
Left = 1050
Max = 2050
Min = 1950
TabIndex = 4
Top = 90
Value = 1990
Width = 180
End
Begin VB.TextBox txtmonth
Height = 264
Left = 1896
TabIndex = 3
Text = " "
Top = 90
Width = 252
End
Begin VB.TextBox txtyear
Height = 264
Left = 600
TabIndex = 2
Text = " "
Top = 90
Width = 468
End
Begin VB.Label lab2
Caption = "期间"
Height = 255
Left = 1485
TabIndex = 1
Top = 120
Width = 375
End
Begin VB.Label lab1
Caption = "年度"
Height = 255
Left = 195
TabIndex = 0
Top = 120
Width = 375
End
End
Attribute VB_Name = "frmvoucherNo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'凭证缺号查询
'作者:诸涛
Dim Year1 As Integer, Month1 As Integer
Dim bz As Boolean
Dim sDate As Date, eDate As Date
Private Sub cmdOk_Click()
Unload Me
End Sub
Private Sub Form_Load()
Year1 = gclsBase.FYearOfDate(Date)
Month1 = gclsBase.PeriodOfDate(Date)
bz = True
VSc1.Value = Year1
VSc2.Value = Month1
End Sub
Private Sub VSc1_Change()
Year1 = VSc1.Value
txtyear.Text = Year1
lischa.Clear
sDate = 0
eDate = 0
Call gclsBase.DateOfPeriod(Year1, Month1, sDate, eDate)
sqlrecmaxno Year1, Month1
End Sub
Private Sub VSc2_Change()
Month1 = VSc2.Value
txtmonth.Text = Month1
If bz = True Then
bz = False
GoTo endpiont
End If
lischa.Clear
sDate = 0
eDate = 0
Call gclsBase.DateOfPeriod(Year1, Month1, sDate, eDate)
sqlrecmaxno Year1, Month1
endpiont:
End Sub
'取凭证类型,名称,最大号
Private Sub sqlrecmaxno(Year1, Month1)
Dim recYearm As Recordset
Dim recTypeid As Recordset
Dim str As String
Dim lngVoucherTypeID1 As Long
Dim lngReceiptNO1 As Long
Dim strTypeName As String
Dim sum1 As Integer, Sum2 As Integer
Set recTypeid = gclsBase.BaseDB.OpenRecordset("SELECT lngVoucherTypeID,strVoucherTypeName,blnIsInActive FROM VoucherType WHERE blnIsInActive=False ", dbOpenSnapshot)
If recTypeid Is Nothing Or recTypeid.RecordCount <= 0 Then
MsgBox "凭证类型表为空，请先输入 "
Exit Sub
End If
sum1 = 1
Sum2 = 0
With recTypeid
.MoveFirst
Do Until .EOF
lngVoucherTypeID1 = !lngVoucherTypeID
strTypeName = !strVoucherTypeName
strTypeName = Trim(strTypeName)
str = "intYear=" & Year1 & " and bytPeriod=" & Month1 & " and clng(strReceiptNO)=" & lngVoucherTypeID1 & " and lngReceiptTypeID=41 "
Set recYearm = gclsBase.BaseDB.OpenRecordset("SELECT * from receiptMaxNO where " & str, dbOpenSnapshot)
If recYearm Is Nothing Or recYearm.RecordCount <= 0 Then
Sum2 = Sum2 + 1
GoTo EndPoint
End If
With recYearm
.MoveFirst
lngReceiptNO1 = !lngReceiptNo
End With
lischa.AddItem "（" & sum1 & "）" & strTypeName & " 最大编号：" & lngReceiptNO1
sum1 = sum1 + 1
sqlVoucher lngVoucherTypeID1, lngReceiptNO1
lischa.AddItem "------------------------------------------------------"
EndPoint:
.MoveNext
Loop
If recTypeid.RecordCount = Sum2 Then
MsgBox "此年度，期间的凭证在最大编号表中未登记"
End If
End With
recYearm.Close
End Sub
'缺号查询
Private Sub sqlVoucher(ByVal lngVoucherTypeID1 As Long, ByVal lngReceiptNO1 As Long)
Dim recNo As Recordset
Dim str1 As String
Dim I As Integer
Dim strfg1 As String
Dim a As Integer, b As Integer, c As Integer, d As Integer
Dim bz1 As Boolean, bz2 As Boolean, bz3 As Boolean, bz4 As Boolean
str1 = "cdate(strDate)>=#" & sDate & "#" & " and cdate(strDate)<=#" & eDate & "#" & " and lngVoucherTypeID=" & lngVoucherTypeID1
Set recNo = gclsBase.BaseDB.OpenRecordset("SELECT intVoucherNO,blnIsVoid FROM voucher WHERE " & str1, dbOpenSnapshot)
bz1 = True
bz2 = False
bz3 = True
bz4 = False
With recNo
For I = 1 To CInt(lngReceiptNO1)
.FindFirst "intVoucherNO = " & I
If .NoMatch Then
If bz4 Then
If c = d Then
strfg1 = " 作废：" & c
Else
strfg1 = " 作废：" & c & "～" & d
End If
lischa.AddItem strfg1
bz4 = False
End If
If bz1 Then '第一次进入
a = I
b = I
bz1 = False
bz2 = True
Else
If (b = I - 1) And (b <> (lngReceiptNO1 - 1)) Then
b = I '如果连号
ElseIf b = lngReceiptNO1 - 1 Then '连号如果为最后记录
b = I
strfg1 = " 缺号：" & a & "～" & b
lischa.AddItem strfg1
bz2 = False
Else '不连号进入
If bz2 Then
If a = b Then
strfg1 = " 缺号：" & a
Else
strfg1 = " 缺号：" & a & "～" & b
End If
lischa.AddItem strfg1
End If
a = I
b = I
If I = lngReceiptNO1 Then '不连号最后记录
strfg1 = " 缺号：" & a
lischa.AddItem strfg1
bz2 = False
Else: bz2 = True
End If
End If
End If
Else
If !blnIsVoid Then
If bz2 Then
If a = b Then
strfg1 = " 缺号：" & a
Else
strfg1 = " 缺号：" & a & "～" & b
End If
lischa.AddItem strfg1
bz2 = False
End If
If bz3 Then
c = I
d = I
bz3 = False
bz4 = True
Else
If (d = I - 1) And (d <> (lngReceiptNO1 - 1)) Then
d = I
ElseIf d = lngReceiptNO1 - 1 Then
d = I
strfg1 = " 作废：" & c & "～" & d
lischa.AddItem strfg1
bz4 = False
Else
If bz4 Then
If c = d Then
strfg1 = " 作废：" & c
Else: strfg1 = " 作废：" & c & "～" & d
End If
lischa.AddItem strfg1
End If
c = I
d = I
If I = lngReceiptNO1 Then
strfg1 = " 作废：" & c
lischa.AddItem strfg1
bz4 = False
Else: bz4 = True
End If
End If
End If
End If
End If
Next I
If bz2 Then
If a = b Then
strfg1 = " 缺号：" & a
Else
strfg1 = " 缺号：" & a & "～" & b
End If
lischa.AddItem strfg1
End If
If bz4 Then
If c = d Then
strfg1 = " 作废：" & c
Else
strfg1 = " 作废：" & c & "～" & d
End If
lischa.AddItem strfg1
End If
End With
endpiont:
recNo.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -