第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