第11章 开发类模块

11.1 类模块用于创建对象

11.2 词汇基础

11.3 类的重要意义以及为什么使用对象

11.4 创建一个简单的对象

代码清单11.1: SimpleLoan类

 

'Loan properties
Public PrincipalAmount As Variant
Public InterestRate As Variant
Public LoanNumber As Variant
Public Term As Variant

Private Sub Class_Initialize()
    'set default principal amount to 0
    PrincipalAmount = 0
    'set default interest rate to 8 % annually
    InterestRate = 0.08
    'set loan number to 0
    LoanNumber = 0
    'set default term to 36 months
    Term = 36    
End Sub

Public Property Get Payment() As Variant
    Payment = Application.WorksheetFunction.Pmt(InterestRate / 12, Term, -PrincipalAmount)    
End Property

 

 

11.5 使用自己的对象

代码清单11.2：使用对象的两种方式

 

'代码清单 11.2 使用对象的两种方式
Sub TestSimpleLoan()
    'declare a loan variable and explicitly
    'create the object that the variable
    'will refer to
    Dim objLoan1 As New SimpleLoan
    
    'declare a loan variable
    Dim objloan2 As SimpleLoan
    
    'create the object that ojbLoan2
    'will refer to.
    Set objloan2 = New SimpleLoan
    
    'demonstrate that the two
    'loans are separate objects
    objLoan1.LoanNumber = 1
    objloan2.LoanNumber = 2
    Debug.Print "objloan1.LoanNumber is: " & objLoan1.LoanNumber
    Debug.Print "objloan2.LoanNumber is: " & objloan2.LoanNumber
    
    'terminate the objects and free the memory associated with
    'the object variables
    Set objLoan1 = Nothing
    Set objloan2 = Nothing    
End Sub

 

 

11.6 一个更好、更巧妙的对象

代码清单11.3：Loan对象

 

'private class variables to hold property values
Dim mvPrincipalAmount As Variant
Dim mvInterestRate As Variant
Dim mvLoanNumber As Variant
Dim mvTerm As Variant

Private Sub Class_Initialize()
    'set default principal amount to 0
    mvPrincipalAmount = 0
    'set default interest rate to 8 % annually
    mvInterestRate = 0.08
    'set loan number to 0
    mvLoanNumber = 0
    'set term to 0 months
    mvTerm = 0    
End Sub


Public Property Get PrincipalAmount() As Variant
    PrincipalAmount = mvPrincipalAmount
End Property

Public Property Let PrincipalAmount(ByVal vNewValue As Variant)
    mvPrincipalAmount = vNewValue
End Property

Public Property Get InterestRate() As Variant
    InterestRate = mvInterestRate
End Property

Public Property Let InterestRate(ByVal vNewValue As Variant)
    mvInterestRate = vNewValue
End Property

Public Property Get LoanNumber() As Variant
    LoanNumber = mvLoanNumber
End Property

Public Property Let LoanNumber(ByVal vNewValue As Variant)
    mvLoanNumber = vNewValue
End Property

Public Property Get Term() As Variant
    Term = mvTerm
End Property

Public Property Let Term(ByVal vNewValue As Variant)
    mvTerm = vNewValue
End Property

Public Property Get Payment() As Variant
    Payment = Application.WorksheetFunction.Pmt( _
　　　　　　　　　　InterestRate / 12, Term, -PrincipalAmount)    
End Property

 

 

11.7 对象解释

代码清单11.4：使用Loan对象计算贷款支付额

 

'代码清单11.4：使用Loan 对象计算贷款支付额
Sub TestLoanObject()
    Dim rg As Range
    Dim objLoan As Loan
    Set rg = ThisWorkbook.Worksheets("Loans").Range("LoanListStart").Offset(1, 0)
    Set objLoan = New Loan
    
    Do Until IsEmpty(rg)
        With objLoan
        　　.Term = rg.Offset(0, 1).Value
        　　.InterestRate = rg.Offset(0, 2).Value
        　　.PrincipalAmount = rg.Offset(0, 3).Value

        　　rg.Offset(0, 4).Value = .Payment
        End With
        Set rg = rg.Offset(1, 0)
    Loop
    
    Set objLoan = Nothing
    Set rg = Nothing
End Sub

  

代码清单11.5：不使用Loan对象的情况下计算贷款支付额 

'代码清单11.5:不使用Loan对象的情况下计算贷款支付额
Public Function Payment(vInterestRate As Variant, vTerm As Variant, vPrincipalAmount) As Variant
    Payment = Application.WorksheetFunction.Pmt(vInterestRate / 12, vTerm, vPrincipalAmount)

End Function

Sub testNoObject()
    Dim rg As Range
    Dim vTerm As Variant
    Dim vInterestRate As Variant
    Dim vPrincipalAmount As Variant
    
    Set rg = ThisWorkbook.Worksheets("Loan").Range("LoanListStart").Offset(1, 0)
    
    Do Until IsEmpty(rg)
        vTerm = rg.Offset(0, 1).Value
        vInterestRate = rg.Offset(0, 2).Value
        vPrincipalAmount = rg.Offset(0, 3).Value
        rg.Offset(0, 4).Value = Payment(vInterestRate, vTerm, vPrincipalAmount)
    Loop
    Set rg = Nothing        
End Sub

 

 

11.8 收集自己的对象

代码清单11.6：使用 Collection 对象作为多个对象的容器

 

'代码清单11.6：使用 Collection 对象作为多个对象的容器
Sub TestCollectionObject()
    Dim rg As Range
    Dim objLoans As Collection
    Dim objLoan As Loan
    
    Set rg = ThisWorkbook.Worksheets("Loans").Range("LoanListStart").Offset(1, 0)
    
    'get the collection of loan objects
    Set objLoans = CollectLoanObjects(rg)
    
    Debug.Print "There are " & objLoans.Count & " loans."
    
    'iterate through each loan
    For Each objLoan In objLoans
        Debug.Print "Loan Number " & objLoan.LoanNumber & " has a payment of "; Format(objLoan.Payment, "currency")
    Next
    
    Set objLoans = Nothing
    Set objLoan = Nothing
    Set rg = Nothing
    
End Sub

Function CollectLoanObjects(rg As Range) As Collection
    Dim objLoan As Loan
    Dim objLoans As Collection
    Set objLoans = New Collection
    
    'loop until we find an empty row
    Do Until IsEmpty(rg)
        Set objLoan = New Loan
        With objLoan
            .LoanNumber = rg.Value
            .Term = rg.Offset(0, 1).Value
            .InterestRate = rg.Offset(0, 2).Value
            .PrincipalAmount = rg.Offset(0, 3).Value
            
        End With
        
        'add the current loan to the collection
        objLoans.Add objLoan, CStr(objLoan.LoanNumber)
        
        'move to next row
        Set rg = rg.Offset(1, 0)
        
    Loop
    
    Set objLoan = Nothing
    Set CollectLoanObjects = objLoans
    Set objLoans = Nothing

End Function

 

 代码清单11.7：使用比较难的方法(数组)收集对象

 

'代码清单11.7：使用比较难的方法(数组)收集对象
Sub TestCollectLoansTheHardWay()

End Sub

Function collectLoansTheHardWay(rg As Range) As Variant()
    Dim vTerm As Variant
    Dim vInterestRate As Variant
    Dim vPrincipalAmount As Variant
    
    Dim vLoans() As Variant
    Dim nRows As Long
    Dim nItem As Long
    
    'figure out how many rows there are
    nRows = rg.End(xlDown).Row - rg.Row
    
    'resize the array to reflect the number of rows
    ReDim vLoans(nRows, 3)
    
    'initialize array loan index
    nItem = 0
    
    'ok - read in the values
    Do Until IsEmpty(rg)
        'loan number
        vLoans(nItem, 0) = rg.Value
        'term
        vLoans(nItem, 1) = rg.Offset(0, 1).Value
        'interest rate
        vLoans(nItem, 2) = rg.Offset(0, 2).Value
        'principal amount
        vLoans(nItem, 3) = rg.Offset(0, 3).Value
        
        Set rg = rg.Offset(1, 0)
        nItem = nItem + 1
    Loop
    
    collectLoansTheHardWay = vLoans
        
End Function

 

 

11.9 实现更准确的属性

 代码清单11.8：在Property Let过程中验证数据有效性

 

'private class variables to hold property values
Dim mcPrincipalAmount As Currency
Dim mdInterestRate As Double
Dim mdLoanNumber As Long
Dim mnTerm As Long

'create an enumeration of loan terms
'set each value equal to the term in months
Enum lnLoanTerm
    ln2years = 24
    ln3years = 36
    ln4years = 48
    ln5years = 60
    ln6years = 72
End Enum

'lending limits
Private Const MIN_LOAN_AMT = 5000
Private Const MAX_LOAN_AMT = 7500

'INTEREST RATE LIMITS
Private Const MIN_INTEREST_RATE = 0.04
Private Const MAX_INTEREST_RATE = 0.21
    
Private Sub Class_Initialize()
    'set default principal amount to 0
    mcPrincipalAmount = 0
    'set default interest rate to 8 % annually
    mdInterestRate = 0.08
    'set loan number to 0
    mdLoanNumber = 0
    'set term to 0 months
    mnTerm = ln3years    
End Sub


Public Property Get PrincipalAmount() As Currency
    PrincipalAmount = mcPrincipalAmount
End Property

Public Property Let PrincipalAmount(ByVal PrincipalAmt As Currency)
    If PrincipalAmt < MIN_LOAN_AMT Or PrincipalAmt > MAX_LOAN_AMT Then
        'don't change value
        'raise error
        Err.Raise vbObjectError + 1, "Loan Class", "invalid loan amount. loans must be between" _
         & MIN_LOAN_AMT & " and " & MAX_LOAN_AMT & " inclusive."
    Else
        mcPrincipalAmount = PrincipalAmt
    End If
End Property

Public Property Get InterestRate() As Double
    InterestRate = mdInterestRate
End Property

Public Property Let InterestRate(ByVal Rate As Double)
    If Rate < MIN_INTEREST_RATE Or Rate > MAX_INTEREST_RATE Then
        'don't change value
        'raise error
        Err.Raise vbObjectError + 2, "Loan Class", _
            "invalid interest rate. Rate must be between" & _
             MIN_INTEREST_RATE & " and " & MAX_INTEREST_RATE & " inclusive."
    Else
        mdInterestRate = Rate
    End If
End Property

Public Property Get LoanNumber() As Long
    LoanNumber = mdLoanNumber
End Property

Public Property Let LoanNumber(ByVal LoanNbr As Long)
    mdLoanNumber = LoanNbr
End Property

Public Property Get Term() As lnLoanTerm
    Term = mnTerm
End Property

Public Property Let Term(ByVal Term As lnLoanTerm)
    Select Case Term
        Case ln2years, ln3years, ln4years, ln5years, ln6years
            mnTerm = Term
        Case Else
            'don't change current value
            'raise error
            Err.Raise vbObjectError + 3, "Loan Class", _
                "Invalid loan term. Use one of the lnLoanTerm values"            
    End Select
End Property

Public Property Get Payment() As Variant
    Payment = Application.WorksheetFunction.Pmt(InterestRate / 12, Term, -PrincipalAmount)    
End Property