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

Материал из VB Эксперт
Перейти к: навигация, поиск

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>
Источник — «http://vbex.ru/index.php?title=VBA/Excel/Access/Word/Data_Type_Functions/Class&oldid=1761»