📄 frmreport.frm
字号:
End If
'Exit Sub
If Text1.Text = "" Then
MsgBox "Enter Text to Search", vbOKOnly + vbCritical, "Error"
Text1.SetFocus
Exit Sub
End If
If Combo1.ListIndex = 0 Then
Search_Name
ElseIf Combo1.ListIndex = 1 Then
Search_Date
ElseIf Combo1.ListIndex = 2 Then
'Search_payment
End If
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Combo1.ListIndex = -1
filllist
End Sub
Private Sub Command3_Click()
Text1.Text = ""
Combo1.ListIndex = -1
Me.Hide
End Sub
Private Sub Command4_Click()
If lvReport.ListItems.count >= 1 Then
Printer.CurrentY = 200
Printer.CurrentX = 3000
Printer.Print UCase(Company)
Printer.CurrentX = 3200
Printer.Print Add
Printer.Print ""
Printer.CurrentX = 200
Printer.Print "User Name: " & UCase(UserName) & " Date: " & Date
Printer.Print ""
Printer.Print ""
Printer.CurrentX = 100
Printer.Print " DAILY EVALUATION REPORT "
Printer.Print "----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------"
Printer.CurrentY = 1700
Printer.CurrentX = 200
Printer.Print "S/No"
Printer.CurrentY = 1700
Printer.CurrentX = 1000
Printer.Print "Payment Type"
Printer.CurrentY = 1700
Printer.CurrentX = 2500
Printer.Print "Name"
Printer.CurrentY = 1700
Printer.CurrentX = 4500
Printer.Print "Room No."
Printer.CurrentY = 1700
Printer.CurrentX = 5500
Printer.Print "Payment Date"
Printer.CurrentY = 1700
Printer.CurrentX = 7000
Printer.Print "Amount"
Printer.CurrentY = 1700
Printer.CurrentX = 8500
Printer.Print "Service Charge"
Printer.CurrentY = 1700
Printer.CurrentX = 10000
Printer.Print "V.A.T"
'Printer.CurrentX = 100
Printer.Print "----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------"
'For i = lvReport. To lvReport.ListItems.Add
'Do While lvReport.ListItems
Printer.CurrentY = 2100
Printer.CurrentX = 1000
Printer.Print lvReport.ListItems.Item(i).SubItems(1)
Printer.CurrentY = 2100
Printer.CurrentX = 2500
Printer.Print lvReport.ListItems.Item(i).SubItems(3)
Printer.CurrentY = 2100
Printer.CurrentX = 4500
Printer.Print lvReport.ListItems.Item(i).SubItems(4)
Printer.CurrentY = 2100
Printer.CurrentX = 5500
Printer.Print lvReport.ListItems.Item(i).SubItems(5)
Printer.CurrentY = 2100
Printer.CurrentX = 7000
Printer.Print lvReport.ListItems.Item(i).SubItems(6)
Printer.CurrentY = 2100
Printer.CurrentX = 8500
Printer.Print lvReport.ListItems.Item(i).SubItems(7)
Printer.CurrentY = 2100
Printer.CurrentX = 10000
Printer.Print lvReport.ListItems.Item(i).SubItems(8)
'Wend
End If
End Sub
Private Sub Form_Load()
Top = 3000
Left = 3000
Connect
filllist
Combo1.AddItem "Name"
Combo1.AddItem "Date"
Combo1.AddItem "Payment Type"
lblcount2.Caption = ""
'fillgrid
End Sub
Sub filllist()
With lvReport
.view = lvwReport
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "S/No"
.ColumnHeaders.Add , , "Payment Type"
.ColumnHeaders.Add , , "Guest ID"
.ColumnHeaders(3).Width = 2500
.ColumnHeaders.Add , , "Name"
.ColumnHeaders(4).Width = 3000
.ColumnHeaders.Add , , "Room No"
.ColumnHeaders.Add , , "Date of Payment"
.ColumnHeaders(6).Width = 2500
.ColumnHeaders.Add , , "Amount"
.ColumnHeaders.Add , , "Service Charge"
.ColumnHeaders(8).Width = 2500
.ColumnHeaders.Add , , "VAT"
End With
Call Connect
If RS_Paymentlog.State = adStateOpen Then RS_Paymentlog.Close
RS_Paymentlog.Open "Select * from payment_log order by guestid", cnn, adOpenStatic, adLockOptimistic
lvReport.ListItems.Clear
With RS_Paymentlog
While Not .EOF
Set itm = lvReport.ListItems.Add(, , .RecordCount)
itm.SubItems(1) = .Fields(3)
itm.SubItems(2) = .Fields(0)
itm.SubItems(3) = .Fields(1)
itm.SubItems(4) = .Fields(5)
itm.SubItems(5) = .Fields(10)
itm.SubItems(6) = .Fields(6)
itm.SubItems(7) = Val(.Fields(6)) / 100 * 10
itm.SubItems(8) = Val(.Fields(6)) / 100 * 5
.MoveNext
Wend
lblcount2.Caption = "Total Records = " & lvReport.ListItems.count
End With
Dim var As Integer
Dim var2 As Integer
Dim var3 As Integer
Dim i As Integer
'Declare variables
'
ListCount = lvReport.ListItems.count
'count how many rows are in ListView
'
For i = 1 To ListCount
'Go from 1st row to last
var = var + lvReport.ListItems(i).SubItems(6)
var2 = var2 + lvReport.ListItems(i).SubItems(7)
var3 = var3 + lvReport.ListItems(i).SubItems(8)
'each loop, add value from listview to v
' ar
'replace the 1 in "(1)" with the column
' number
'*column # starts at 0
'(i) is the row nuber
Next i
'loop
'
Text2.Text = var
Text3.Text = var2
Text4.Text = var3
End Sub
Sub Search_Name()
lvReport.ListItems.Clear
' record variables
Dim mark As Variant
Dim count As Integer
Call Connect
count = 0
With RS_Payment
'listview1= .RecordCount + 1
r = 1
.Find "name LIKE '" & Text1.Text & "%'"
'.MoveFirst
Do While Not .EOF
'continue if last find succeeded
Set itm = lvReport.ListItems.Add(, , .Fields(3))
itm.SubItems(1) = .Fields(0)
itm.SubItems(2) = .Fields(1)
itm.SubItems(3) = .Fields(5)
itm.SubItems(4) = .Fields(11)
itm.SubItems(5) = .Fields(6)
itm.SubItems(6) = Val(.Fields(6)) / 100 * 10
itm.SubItems(7) = Val(.Fields(6)) / 100 * 5
'count the last title found
count = count + 1
' note current position
mark = .Bookmark
.Find "name LIKE '" & Text1.Text & "%'", 1, adSearchForward, mark
' above code skips current record to avoid finding the same row repeatedly;
' last arg (bookmark) is redundant because Find searches from current position
'r = r + 1
'.MoveNext
Loop
'
If count = 0 Then
MsgBox "No Match Found", vbOKOnly + vbInformation, "Information"
filllist
Text1.SetFocus
Else
lblcount2.Caption = "Total Matches found " & count
End If
' clean up
RS_Payment.Close
End With
'
End Sub
Sub Search_Date()
lvReport.ListItems.Clear
' record variables
Dim mark As Variant
Dim count As Integer
Call Connect
count = 0
With RS_Payment
'listview1= .RecordCount + 1
r = 1
.Find "Date_Modified LIKE '" & Text1.Text & "%'"
'.MoveFirst
Do While Not .EOF
'continue if last find succeeded
Set itm = lvReport.ListItems.Add(, , .Fields(3))
itm.SubItems(1) = .Fields(0)
itm.SubItems(2) = .Fields(1)
itm.SubItems(3) = .Fields(5)
itm.SubItems(4) = .Fields(11)
itm.SubItems(5) = .Fields(6)
itm.SubItems(6) = Val(.Fields(6)) / 100 * 10
itm.SubItems(7) = Val(.Fields(6)) / 100 * 5
'count the last title found
count = count + 1
' note current position
mark = .Bookmark
.Find "Date_Modified LIKE '" & Text1.Text & "%'", 1, adSearchForward, mark
' above code skips current record to avoid finding the same row repeatedly;
' last arg (bookmark) is redundant because Find searches from current position
'r = r + 1
'.MoveNext
Loop
'
If count = 0 Then
MsgBox "No Match Found", vbOKOnly + vbInformation, "Information"
filllist
Text1.SetFocus
Else
lblcount2.Caption = "Total Matches found " & count
End If
' clean up
RS_Payment.Close
End With
'
End Sub
Sub fillgrid()
Connect
'flex1.Clear
flex1.FormatString = "Enroll No|<Candidate Name |Father Name |Course Enrolled |DOB "
'If RS_Payment.State = adStateOpen Then RS_Payment.Close
If RS_Payment.RecordCount > 0 Then
flex1.Rows = RS_Payment.RecordCount + 1
r = 1
With RS_Payment
.MoveFirst
Do While Not .EOF
flex1.TextMatrix(r, 0) = RS_Payment!GuestID
If IsNull(!GuestID) = False Then flex1.TextMatrix(r, 1) = !GuestID
If IsNull(!Name) = False Then flex1.TextMatrix(r, 2) = !Name
If IsNull(!Payment_Type) = False Then flex1.TextMatrix(r, 3) = !Payment_Type
If IsNull(!payment) = False Then flex1.TextMatrix(r, 4) = !Advance
r = r + 1
.MoveNext
Loop
'End If
'End If
'End If
'End If
End With
'End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -