⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 vrental_engine.cls

📁 ado+ACCE
💻 CLS
📖 第 1 页 / 共 5 页
字号:
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 + -