11.1 类模块用于创建对象
11.2 词汇基础
11.3 类的重要意义以及为什么使用对象
11.4 创建一个简单的对象
代码清单11.1: SimpleLoan类
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'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
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:使用对象的两种方式
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'代码清单 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
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对象
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'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( _
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
End Property
11.7 对象解释
代码清单11.4:使用Loan对象计算贷款支付额
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'代码清单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
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对象的情况下计算贷款支付额
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'代码清单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
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 对象作为多个对象的容器
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'代码清单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
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:使用比较难的方法(数组)收集对象
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'代码清单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
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过程中验证数据有效性
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'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
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