VBA/Excel/Access/Word/Data Type Functions/Class

Abstraction

 
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

Class Module: FileInformation

 
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

Class Module: FullName

 
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

Creating and Using a Class Module

 
"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

Creating Custom Objects

 
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

Creating the MyRectangle Class

 
    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

Loan Object Implementation Details

 
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

Rectangle class

 
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

The SimpleLoan Class

 
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