VBA/Excel/Access/Word/Data Type Functions/Class
Содержание
Abstraction
<source lang="vb">
Option Compare Database Option Explicit Private dblHeight As Double Private dblWidth As Double Public Property Let Height(dblParam As Double)
dblHeight = dblParam
End Property Public Property Let Width(dblParam As Double)
dblWidth = dblParam
End Property Public Property Get Height() As Double
Height = dblHeight
End Property Public Property Get Width() As Double
Width = dblWidth
End Property Public Property Get Area() As Double
Area = (dblHeight * dblWidth) / 2
End Property Public Sub DoubleSides()
dblHeight = dblHeight * 2 dblWidth = dblWidth * 2
End Sub """""""""""""""""""""""""""" Sub ClassDemo2()
Dim objKite As MyKite Set objKite = New MyKite objKite.Height = 5 objKite.Width = 8 Debug.Print "The area of a kite measuring " & objKite.Height & _ " x " & objKite.Width & " is " & objKite.Area objKite.DoubleSides Debug.Print "The area of a kite measuring " & objKite.Height & _ " x " & objKite.Width & " is " & objKite.Area Set objKite = Nothing
End Sub
</source>
Class Module: FileInformation
<source lang="vb">
Private mstrFullFileName As String Private mstrDrive As String Private mstrPath As String Private mstrName As String Public Property Get FullFileName() As String
FullFileName = mstrFullFileName
End Property Public Property Let FullFileName(ByVal strFileName As String)
Call GetDrive(strFileName) Call GetPath(strFileName) Call GetName(strFileName)
End Property Public Property Get Drive() As String
Drive = mstrDrive
End Property Public Property Get Path() As String
Path = mstrPath
End Property Public Property Get Name() As String
Name = mstrName
End Property Private Sub GetDrive(ByVal strFile As String)
mstrDrive = Left(strFile, InStr(strFile, ":"))
End Sub Private Sub GetPath(ByVal strFile As String)
mstrPath = Mid(strFile, 1, InStrRev(strFile, "\"))
End Sub Private Sub GetName(strFile)
mstrName = Mid(strFile, InStrRev(strFile, "\") + 1)
End Sub
</source>
Class Module: FullName
<source lang="vb">
Private mstrFullFileName As String Private mstrDrive As String Private mstrPath As String Private mstrName As String Public Property Get FullFileName() As String
FullFileName = mstrFullFileName
End Property Public Property Let FullFileName(ByVal strFileName As String)
Call GetDrive(strFileName) Call GetPath(strFileName) Call GetName(strFileName)
End Property Public Property Get Drive() As String
Drive = mstrDrive
End Property Public Property Get Path() As String
Path = mstrPath
End Property Public Property Get Name() As String
Name = mstrName
End Property Private Sub GetDrive(ByVal strFile As String)
"Everything before the : is the drive mstrDrive = Left(strFile, _ InStr(strFile, ":"))
End Sub Private Sub GetPath(ByVal strFile As String)
"Everything up until the last backslash "is the path mstrPath = _ Mid(strFile, 1, InStrRev(strFile, "\"))
End Sub Private Sub GetName(strFile)
"Everything after the last backslash "is the name mstrName = _ Mid(strFile, InStrRev(strFile, "\") + 1)
End Sub
</source>
Creating and Using a Class Module
<source lang="vb">
"Class Module: Employee Public FirstName As String Public LastName As String Public Function Speak()
Speak = FirstName & " " & LastName
End Function "test Module Sub SingleInstance()
Dim oPerson As Employee Set oPerson = New Employee oPerson.FirstName = "A" oPerson.LastName = "Balter" msgBox oPerson.Speak
End Sub ""Property Let and Get Adding Properties the Right Way Private mstrFirstName As String Private mstrLastName As String Public Property Get FirstName() As String
FirstName = mstrFirstName
End Property Public Property Let FirstName(ByVal strNewValue As String)
mstrFirstName = UCase(strNewValue)
End Property Public Property Get LastName() As String
LastName = mstrLastName
End Property Public Property Let LastName(ByVal strNewValue As String)
mstrLastName = UCase(strNewValue)
End Property "Setting Values with Property Set Private mobjCustomer As Employee Public Property Set GoodEmployee(objCustomer As Employee)
Set mobjCustomer = objCustomer
End Property "Class Module: Employee Public FirstName As String Public LastName As String Public Function Speak()
Speak = FirstName & " " & LastName
End Function "test Module Sub SingleInstance()
Dim oPerson As Employee Set oPerson = New Employee oPerson.FirstName = "A" oPerson.LastName = "Balter" msgBox oPerson.Speak
End Sub "Creating Multiple Class Instances Sub MultipleInstance()
Dim oPerson1 As Employee Dim oPerson2 As Employee Set oPerson1 = New Employee Set oPerson2 = New Employee oPerson1.FirstName = "A" oPerson1.LastName = "B" Debug.Print oPerson1.Speak oPerson2.FirstName = "Dan" oPerson2.LastName = "B" Debug.Print oPerson2.Speak
End Sub "Define Class Initialize event method and Terminate event method Public FirstName As String Public LastName As String Public Function Speak()
Speak = FirstName & " " & LastName
End Function
"test Module Sub SingleInstance()
Dim oPerson As Employee Set oPerson = New Employee oPerson.FirstName = "A" oPerson.LastName = "Balter" msgBox oPerson.Speak
End Sub "Use the Initialize event to perform tasks such as establishing a connection to a database and initializing variables. Private Sub Class_Initialize()
FirstName = "A" LastName = "Balter"
End Sub "You generally use the Terminate event to perform the class"s cleanup tasks. Private Sub Class_Terminate()
rstCustomer.Close Set rstCustomer = Nothing
End Sub
</source>
Creating Custom Objects
<source lang="vb">
Option Explicit Private m_LastName As String Private m_FirstName As String Private m_Salary As Currency Private m_Id As String Property Get Id() As String
Id = m_Id
End Property Property Get LastName() As String
LastName = m_LastName
End Property Property Get FirstName() As String
FirstName = m_FirstName
End Property Property Get Salary() As Currency
Salary = m_Salary
End Property Property Let Id(ref As String)
m_Id = ref
End Property Property Let LastName(L As String)
m_LastName = L
End Property Property Let FirstName(F As String)
m_FirstName = F
End Property Property Let Salary(ByVal dollar As Currency)
m_Salary = dollar
End Property Public Function CalcNewSalary(choice As Integer, curSalary As Currency, _
amount As Long) As Currency Select Case choice Case 1 " by percent CalcNewSalary = curSalary + ((curSalary * amount) / 100) Case 2 " by amount CalcNewSalary = curSalary + amount End Select
End Function
</source>
Creating the MyRectangle Class
<source lang="vb"> Option Compare Database Option Explicit Private dblHeight As Double Private dblWidth As Double Public Property Let Height(dblParam As Double) dblHeight = dblParam End Property Public Property Let Width(dblParam As Double) dblWidth = dblParam End Property Public Property Get Height() As Double Height = dblHeight End Property Public Property Get Width() As Double Width = dblWidth End Property Public Property Get Area() As Double Area = dblHeight * dblWidth End Property
""""""""""""""""""""""""""""""""""""""""""""""""""""" Sub ClassDemo()
Dim objRect As MyRectangle Set objRect = New MyRectangle objRect.Height = 5 objRect.Width = 8 Debug.Print "The area of a rectangle measuring " & objRect.Height & _ " x " & objRect.Width & " is " & objRect.Area Set objRect = Nothing
End Sub
</source>
Loan Object Implementation Details
<source lang="vb">
Option Explicit
Public PrincipalAmount As Variant Public InterestRate As Variant Public LoanNumber As Variant Public Term As Variant Private Sub Class_Initialize()
PrincipalAmount = 0 InterestRate = 0.08 LoanNumber = 0 Term = 36
End Sub Public Property Get Payment() As Variant
Payment = Application.WorksheetFunction.Pmt _ (InterestRate / 12, Term, -PrincipalAmount)
End Property 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 _ (mvInterestRate / 12, mvTerm, -mvPrincipalAmount)
End Property
</source>
Rectangle class
<source lang="vb">
Option Compare Database Option Explicit Private dblHeight As Double Private dblWidth As Double Public Property Let Height(dblParam As Double)
dblHeight = dblParam
End Property Public Property Let Width(dblParam As Double)
dblWidth = dblParam
End Property Public Property Get Height() As Double
Height = dblHeight
End Property Public Property Get Width() As Double
Width = dblWidth
End Property Public Property Get Area() As Double
Area = (dblHeight * dblWidth) / 2
End Property Public Sub DoubleSides()
dblHeight = dblHeight * 2 dblWidth = dblWidth * 2
End Sub
</source>
The SimpleLoan Class
<source lang="vb">
Option Explicit " Loan Properties Public PrincipalAmount As Variant Public InterestRate As Variant Public LoanNumber As Variant Public Term As Variant Private Sub Class_Initialize()
PrincipalAmount = 0 InterestRate = 0.08 LoanNumber = 0 Term = 36
End Sub Public Property Get Payment() As Variant
Payment = Application.WorksheetFunction.Pmt _ (InterestRate / 12, Term, -PrincipalAmount)
End Property
Sub TestSimpleLoan()
Dim objLoan1 As New SimpleLoan Dim objLoan2 As SimpleLoan Set objLoan2 = New SimpleLoan objLoan1.LoanNumber = 1 objLoan2.LoanNumber = 2 Debug.Print "objLoan1.LoanNumber is: " & objLoan1.LoanNumber Debug.Print "objLoan2.LoanNumber is: " & objLoan2.LoanNumber Set objLoan1 = Nothing Set objLoan2 = Nothing
End Sub
</source>