Category Archives: MS Office

Excel search from right to left

Posted on by
Reply


Function RevInStr(findin As Range, tofind As String) As Integer

' Chris Rae's VBA Code Archive - http://chrisrae.com/vba

Dim findcha As Integer

For findcha = Len(findin) - Len(tofind) + 1 To 1 Step -1

If Mid(findin, findcha, Len(tofind)) = tofind Then

RevInStr = findcha

Exit Function

End If

Next findcha

' Defaults to zero anyway (tsk, tsk, etc)

End Function

class collection in VBA

Posted on by
Reply

Warning: WP_Syntax::substituteToken(): Argument #1 ($match) must be passed by reference, value given in D:\InetPub\vhosts\kwu-1639.package\kennywu.info\wwwroot\wp-content\plugins\wp-syntax\wp-syntax.php on line 380

Warning: WP_Syntax::substituteToken(): Argument #1 ($match) must be passed by reference, value given in D:\InetPub\vhosts\kwu-1639.package\kennywu.info\wwwroot\wp-content\plugins\wp-syntax\wp-syntax.php on line 380

Warning: WP_Syntax::substituteToken(): Argument #1 ($match) must be passed by reference, value given in D:\InetPub\vhosts\kwu-1639.package\kennywu.info\wwwroot\wp-content\plugins\wp-syntax\wp-syntax.php on line 380

It takes more effect to set up you collection in a class module but it will make your code more portable and easier to maintain.
Employee class

Option Explicit
 
Private FName As String
Private FHoursPerWeek As Double
Private FRate As Double
 
Public Function GetGrossWeeklyPay() As Double
    GetGrossWeeklyPay = FHoursPerWeek * FRate
End Function
 
Public Property Get Name() As String
    Name = FName
End Property
 
Public Property Get HoursPerWeek() As Double
    HoursPerWeek = FHoursPerWeek
End Property
 
Public Property Get Rate() As Double
    Rate = FRate
End Property
 
Public Property Let Name(v As String)
    FName = v
End Property
 
Public Property Let HoursPerWeek(v As Double)
     FHoursPerWeek = v
End Property
 
Public Property Let Rate(v As Double)
    FRate = v
End Property

Emoployees class

Option Explicit
 
Private FEmployees As New Collection
Public Function Add(ByVal value As Employee)
    Call FEmployees.Add(value, value.Name)
End Function
 
Public Property Get Count() As Long
    Count = FEmployees.Count
End Property
 
Public Property Get Items() As Collection
    Set Items = FEmployees
End Property
 
Public Property Get Item(ByVal v As Variant) As Employee
    Set Item = FEmployees(v)
End Property
 
Public Sub remove(ByVal v As Variant)
    Call FEmployees.remove(v)
End Sub

test module

Option Explicit
Dim theEmployees As New Employees
 
Sub testEmployeesCollection()
    Dim anEmployee As Employee
    Dim I As Long
 
    For I = theEmployees.Count To 1 Step -1
        Call theEmployees.remove(I)
    Next I
 
    Set anEmployee = New Employee
    anEmployee.Name = "Paul Kimmel"
    anEmployee.Rate = 15
    anEmployee.HoursPerWeek = 45
    Call theEmployees.Add(anEmployee)
 
    Set anEmployee = New Employee
    anEmployee.Name = "Bill Gates"
    anEmployee.Rate = 13
    anEmployee.HoursPerWeek = 56
    Call theEmployees.Add(anEmployee)
 
    Debug.Print "number of employees = " & theEmployees.Count
    Debug.Print "employees(2) = " & theEmployees.Item(2).Name
    Debug.Print "employees(paul kimmel rate) = " & theEmployees.Item("Paul Kimmel").Rate
    For Each anEmployee In theEmployees.Items
        Debug.Print anEmployee.Name & "earns $" & anEmployee.GetGrossWeeklyPay()
    Next anEmployee
End Sub

Event in VBA

Posted on by
Reply

Warning: WP_Syntax::substituteToken(): Argument #1 ($match) must be passed by reference, value given in D:\InetPub\vhosts\kwu-1639.package\kennywu.info\wwwroot\wp-content\plugins\wp-syntax\wp-syntax.php on line 380

Windows are build upon three pillars: state, behavior and signal. They are implemented by property, method and events. Events are the way server (producer) signal to client (consumer) that some action has occurred and if desired, now is a good time to respond.
The server defines the events that act as the signature of the place holders and raise the events in the places that clients are permitted to insert their code.
From the client’s perspective, an event is an opportunity to respond to the changing state of an object. The following code is from VB & VBA in a Nutshell: The Language

  • Events can be declared and fired only from within object modules (i.e., Form, User Control, and Class modules). You can’t declare and fire events from a standard code module.
  • Events can be handled or intercepted only from within object modules. You can’t handle any type of event from within a code module. This isn’t really a limitation because you can simply include a call to a function or sub within a code module from within your event handler, to pass program control to a code module–just like you would write code in form and control event handlers.
  • The event declaration must be Public so that it’s visible outside the object module; it can’t be declared as Friend or Private.
  • You can’t declare an object variable as WithEvents if the object doesn’t have any events.
  • To allow the client application to handle the event being fired, the object variable must be declared using the WithEvents keyword.
  • VB custom events don’t return a value; however, you can use a ByRef argument to return a value
  • If your class is one of many held inside a collection, the event isn’t fired to the “outside world”–unless you have a live object variable referencing the particular instance of the class raising the event.
Server code: 
Public Event Warning(sMsg As String, ByRef Cancel As Boolean)
 
Public Property Let ClaimValue(dVal As Double)
 
   Dim blnCancel As Boolean
 
   If dVal > 100 Then
      RaiseEvent Warning("The Claim Value appears high", _
                         blnCancel)
      If blnCancel Then
         Exit Property
      End If
   End If
 
   mdClaimValue = dVal
 
End Property
 
Client code: 
Private WithEvents oServer As clsServer
 
Private Sub cmdAdd_Click()
    Set oServer = New clsServer
    oServer.ClaimValue = 999
End Sub
 
Private Sub oServer_Warning(sMsg As String, _
                            Cancel As Boolean)
    Dim iResponse As Integer
    iResponse = MsgBox(sMsg & " is this OK?", _
                       vbQuestion + vbYesNo, _
                       "Warning")
    If iResponse = vbNo Then
        Cancel = True
    Else
        Cancel = False
    End If
 
End Sub