📄 vrental_engine.cls
字号:
With FlexMembers
.ColWidth(0) = 600
.ColWidth(1) = 1200 ' ID Number
.ColWidth(2) = 1150 ' Date Entered
.ColWidth(3) = 1450 ' Membership Level
.ColWidth(4) = 1500 ' Family Name
.ColWidth(5) = 1500 ' First Name
.ColWidth(6) = 1500 ' Middle Name
.ColWidth(7) = 1190 ' Birthday
.ColWidth(8) = 400 ' Age
.ColWidth(9) = 800 ' Sex
.ColWidth(10) = 1100 ' Civil Status
.ColWidth(11) = 1450 ' Occupation
.ColWidth(12) = 3500 ' Home Address
.ColWidth(13) = 3500 ' Office/School Address
.ColWidth(14) = 3500 ' Comments
.TextMatrix(0, 0) = "No."
.TextMatrix(0, 1) = "ID Number"
.TextMatrix(0, 2) = "Date Entered"
.TextMatrix(0, 3) = "Membership Level"
.TextMatrix(0, 4) = "Family Name"
.TextMatrix(0, 5) = "First Name"
.TextMatrix(0, 6) = "Middle Name"
.TextMatrix(0, 7) = "Birthday"
.TextMatrix(0, 8) = "Age"
.TextMatrix(0, 9) = "Sex"
.TextMatrix(0, 10) = "Civil Status"
.TextMatrix(0, 11) = "Occupation"
.TextMatrix(0, 12) = "Home Address"
.TextMatrix(0, 13) = "Office/School Address"
.TextMatrix(0, 14) = "Comments"
End With
'' ---------Start SQL
If SearchString = "[All Names]" Or SearchString = "*" Or SearchString = "" Then
mySQL = "SELECT * from [MembersInfo] ORDER by [" & SortByFields & "]"
Else
If SearchMode = True Then
mySQL = "SELECT * from [MembersInfo] WHERE [" & SearchFields & "] LIKE '%" & SearchString & "%' ORDER by [" & SortByFields & "]"
Else
mySQL = "SELECT * from [MembersInfo] WHERE [" & SearchFields & "] = " & """" & SearchString & """" & " ORDER by [" & SortByFields & "]"
End If
End If
adoRecordset.Open mySQL, adoConnection, adOpenStatic, adLockOptimistic, _
adCmdText
'' --------End SQL
If adoRecordset.BOF = True And adoRecordset.EOF = True Then
MsgBox "No records found matching your search. ", vbInformation, "Not found"
Exit Sub
End If
Select Case SortMode
Case True:
'---------- Forward Processing ------------------------------------------
FlexMembers.Rows = 1
loop1 = 0
adoRecordset.MoveFirst
Do Until adoRecordset.EOF
TDM = DoEvents()
loop1 = loop1 + 1
FlexMembers.AddItem ""
For loop2 = 0 To 14
Select Case loop2
Case 0:
FlexMembers.TextMatrix(loop1, loop2) = str(loop1)
Case 1:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![ID NUMBER]
Case 2:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Date Entered]
Case 3:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Membership Level]
Case 4:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Family Name]
Case 5:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![First Name]
Case 6:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Middle Name]
Case 7:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Birthday]
Case 8:
FlexMembers.TextMatrix(loop1, loop2) = GetAge(adoRecordset![Birthday])
Case 9:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Sex]
Case 10:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Civil Status]
Case 11:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Occupation]
Case 12:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Home Address]
Case 13:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![OfficeOrSchool/Address]
Case 14:
FlexMembers.TextMatrix(loop1, loop2) = adoRecordset![Comments]
End Select
Next loop2
adoRecordset.MoveNext
Loop
'FlexMembers.Rows = FlexMembers.Rows - 1
'-----------------------------------------------
Case False:
'---START--- Backward Proceesing (Sort)
Dim tmpArray() As Variant
Dim counter, countdown As Long
counter = 0
loop1 = 0
adoRecordset.MoveFirst
FlexMembers.Rows = 1
Do Until adoRecordset.EOF
TDM = DoEvents()
loop1 = loop1 + 1
counter = counter + 15
ReDim Preserve tmpArray(counter)
'FlexMembers.AddItem ""
For loop2 = 0 To 14
Select Case loop2
Case 0:
tmpArray(counter - 14 + loop2) = str(loop1)
Case 1:
tmpArray(counter - 14 + loop2) = adoRecordset![ID NUMBER]
Case 2:
tmpArray(counter - 14 + loop2) = adoRecordset![Date Entered]
Case 3:
tmpArray(counter - 14 + loop2) = adoRecordset![Membership Level]
Case 4:
tmpArray(counter - 14 + loop2) = adoRecordset![Family Name]
Case 5:
tmpArray(counter - 14 + loop2) = adoRecordset![First Name]
Case 6:
tmpArray(counter - 14 + loop2) = adoRecordset![Middle Name]
Case 7:
tmpArray(counter - 14 + loop2) = adoRecordset![Birthday]
Case 8:
tmpArray(counter - 14 + loop2) = GetAge(adoRecordset![Birthday])
Case 9:
tmpArray(counter - 14 + loop2) = adoRecordset![Sex]
Case 10:
tmpArray(counter - 14 + loop2) = adoRecordset![Civil Status]
Case 11:
tmpArray(counter - 14 + loop2) = adoRecordset![Occupation]
Case 12:
tmpArray(counter - 14 + loop2) = adoRecordset![Home Address]
Case 13:
tmpArray(counter - 14 + loop2) = adoRecordset![Home Address]
Case 14:
tmpArray(counter - 14 + loop2) = adoRecordset![OfficeOrSchool/Address]
Case 15:
tmpArray(counter - 14 + loop2) = adoRecordset![Comments]
End Select
Next loop2
adoRecordset.MoveNext
Loop
'------ Start Backward display
For loop1 = 1 To counter
'' Debug.Print Str(loop1) & ": " & tmpArray(loop1)
Next
loop1 = 0
adoRecordset.MoveFirst
countdown = counter
For loop1 = 1 To counter / 15
TDM = DoEvents()
FlexMembers.AddItem ""
FlexMembers.TextMatrix(loop1, 14) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 13) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 12) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 11) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 10) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 9) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 8) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 7) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 6) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 5) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 4) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 3) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 2) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 1) = tmpArray(countdown)
countdown = countdown - 1
FlexMembers.TextMatrix(loop1, 0) = str(loop1)
countdown = countdown - 1
Next loop1
'---END--- Backward Proceesing (Sort)
End Select
adoRecordset.Close
adoConnection.Close
Set adoRecordset = Nothing
Set adoConnection = Nothing
End Sub
Function Transaction_GetDateDue(ItemCode As String, RefDate As String) As String
On Error GoTo ErrHandler
Dim adoConnection As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim connectString As String
Dim RentalPeriod As Integer
Dim DateDue As Long
Set adoConnection = New ADODB.Connection
Set adoRecordset = New ADODB.Recordset
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\CD_Tapes.mdb;Persist Security Info=False;Jet OLEDB:Database Password=AdmiN"
adoConnection.Open connectString
adoRecordset.Open "SELECT RentalPeriod from [CD Tapes Table] WHERE [Item Code] = '" & ItemCode & "'", adoConnection, adOpenStatic, adLockOptimistic, _
adCmdText
RentalPeriod = adoRecordset![RentalPeriod]
DateDue = Date_CountNumberOfDaysFromJan1Year1ToDec31YearEntered(Format(RefDate, "yyyy") - 1)
DateDue = DateDue + Date_CountDaysInAYear(Format(RefDate, "mm/dd/yyyy"))
DateDue = DateDue + RentalPeriod
Transaction_GetDateDue = Date_GETDATE(DateDue)
Exit Function
ErrHandler:
Transaction_GetDateDue = "Unknown"
End Function
Sub Transaction_LoadItemCodes(cbo As ComboBox)
Dim TDM As Variant
Dim loop1, loop2 As Long
Dim mySQL As String
Dim adoConnection As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim connectString As String
Set adoConnection = New ADODB.Connection
Set adoRecordset = New ADODB.Recordset
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\CD_Tapes.mdb;Persist Security Info=False;Jet OLEDB:Database Password=AdmiN"
adoConnection.Open connectString
adoRecordset.Open "SELECT * from [CD Tapes Table] WHERE [Available] = ""Yes"" ", adoConnection, adOpenStatic, adLockOptimistic, _
adCmdText
If adoRecordset.BOF = True And adoRecordset.EOF = True Then
MsgBox "No Item Codes found. ", vbInformation, "Not found"
Exit Sub
End If
loop1 = 0
adoRecordset.MoveFirst
cbo.Clear
Do Until adoRecordset.EOF
TDM = DoEvents()
loop1 = loop1 + 1
cbo.AddItem adoRecordset![Item Code]
adoRecordset.MoveNext
Loop
adoRecordset.Close
adoConnection.Close
Set adoRecordset = Nothing
Set adoConnection = Nothing
End Sub
Sub Transaction_LoadNameOfMembers(lst As ListBox, ArrayOFNamesAndID(), MembersID())
Dim TDM As Variant
Dim loop1, loop2 As Long
Dim mySQL As String
Dim adoConnection As ADODB.Connection
Dim adoRecordset As ADODB.Recordset
Dim connectString As String
Set adoConnection = New ADODB.Connection
Set adoRecordset = New ADODB.Recordset
connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\MembersDB.mdb;Persist Security Info=False;Jet OLEDB:Database Password=AdmiN"
adoConnection.Open connectString
adoRecordset.Open "SELECT * from [MembersInfo]ORDER BY [Family Name]", adoConnection, adOpenStatic, adLockOptimistic, _
adCmdText
If adoRecordset.BOF = True And adoRecordset.EOF = True Then
MsgBox "No members found. ", vbInformation, "Not found"
Exit Sub
End If
loop1 = 0
adoRecordset.MoveFirst
lst.Clear
Do Until adoRecordset.EOF
TDM = DoEvents()
loop1 = loop1 + 1
ReDim Preserve ArrayOFNamesAndID(loop1)
ReDim Preserve MembersID(loop1)
lst.AddItem adoRecordset![Family Name] & ", " & adoRecordset![First Name] & " " & Mid(adoRecordset![Middle Name], 1, 1) & "."
ArrayOFNamesAndID(loop1) = adoRecordset![Family Name] & ", " & adoRecordset![First Name] & " " & Mid(adoRecordset![Middle Name], 1, 1) & "." & " ID - " & str(adoRecordset![ID NUMBER])
MembersID(loop1) = str(adoRecordset![ID NUMBER])
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -