Creating a Class to Handle Access Form Control Events - class

I'm trying to create a Class which will handle multiple Control Events in Access. This is to save the repetition of typing out many lines of identical code.
I've followed the answer located on the following page, but with a few adjustments to tailor it to Access rahter than Excel.
How to assign a common procedure for multiple buttons?
My Class code below:
Option Compare Database
Public WithEvents ct As Access.CommandButton 'Changed object type to something recognised by Access
Public Sub ct_Click()
MsgBox ct.Name & " clicked!"
End Sub
My Form code below:
Option Compare Database
Private listenerCollection As New Collection
Private Sub Form_Load()
Dim ctItem
Dim listener As clListener
For Each ctItem In Me.Controls
If ctItem.ControlType = acCommandButton Then 'Changed to test whether control is a Command Button
Set listener = New clListener
Set listener.ct = ctItem
listenerCollection.Add listener
End If
Next
End Sub
I have noted with comments where I have made changes to the (working) Excel code. I think the problem comes with the object declaration in the Class. Note: no errors are thrown during this procedure; it simply doesn't trigger the event.
Thanks in advance!
Edit:
I've since narrowed the problem down to there being no '[Event Procedure]' in the 'On Click' Event. If I add it manually, the Class works as expected. Obviously, I don't want to have to add these manually - it defeats the object. Any ideas how I would go about this?

In your OnLoad event you can add this line
Dim ctItem
Dim listener As clListener
For Each ctItem In Me.Controls
If ctItem.ControlType = acCommandButton Then 'Changed to test whether control is a Command Button
Set listener = New clListener
Set listener.ct = ctItem
listener.ct.OnClick = "[Event Procedure]" '<------- Assigned the event handler
listenerCollection.Add listener
End If
Next
Although I'm not sure if this is more is less code than just double clicking in the OnClick in the designer and pasting in a method call. It's cool regardless.
Edit:
You could change your class like this
Public WithEvents ct As Access.CommandButton 'Changed object type to something recognised by Access
Public Function AddControl(ctrl as Access.CommandButton) as Access.CommandButton
set ct = ctrl
ct.OnClick = "[Event Procedure]"
Set AddControl = ct
End Function
Public Sub ct_Click()
MsgBox ct.Name & " clicked!"
End Sub
Then in your form you can add a ct like this
For Each ctItem In Me.Controls
If ctItem.ControlType = acCommandButton Then 'Changed to test whether control is a Command Button
Set listener = New clListener
listener.AddControl ctItem
listenerCollection.Add listener
End If
Next
Now the event handler is added in the class.

A Generic Approach to handling Access Form Controls input with a class module:
This code was crafted to handle an application written within a popup window. The Main Form contains a tab control where each tab contains its own subform to either a linked child table or an independent table. The use or non-use of a tab control shouldn't make any difference to the class module processing.
The code can be trimmed to meet your application's needs. For example one could remove controls that one is not using from the class module. Likewise, the controls collection subroutine can be selective by using the TypeName(Ctl) statement to filter the controls that get added to the collection.
In a class module called clsMultipleControls put the following code.
Option Compare Database
Option Explicit
Private m_PassedControl As Control
Private WithEvents atch As Attachment
Private WithEvents bfrm As BoundObjectFrame
Private WithEvents chk As CheckBox
Private WithEvents cbo As ComboBox
Private WithEvents btn As CommandButton
Private WithEvents cctl As CustomControl
Private WithEvents img As Image
Private WithEvents lbl As Label
Private WithEvents lin As Line
Private WithEvents Lst As ListBox
Private WithEvents frm As ObjectFrame
Private WithEvents optb As OptionButton
Private WithEvents optg As OptionGroup
Private WithEvents pg As Page
Private WithEvents pgb As PageBreak
Private WithEvents Rec As Rectangle
Private WithEvents sfm As SubForm
Private WithEvents tctl As TabControl
Private WithEvents txt As TextBox
Private WithEvents tgl As ToggleButton
Property Set ctl(PassedControl As Control)
Set m_PassedControl = PassedControl
Select Case TypeName(PassedControl)
Case "Attachment"
Set atch = PassedControl
Case "BoundObjectFrame"
Set bfrm = PassedControl
Case "CheckBox"
Set chk = PassedControl
Case "ComboBox"
Set cbo = PassedControl
Case "CommandButton"
Set btn = PassedControl
Case "CustomControl"
Set cctl = PassedControl
Case "Image"
Set img = PassedControl
Case "Label"
Set lbl = PassedControl
Case "Line"
Set lin = PassedControl
Case "ListBox"
Set Lst = PassedControl
Case "ObjectFrame"
Set frm = PassedControl
Case "OptionButton"
Set optb = PassedControl
Case "OptionGroup"
Set optg = PassedControl
Case "Page"
Set pg = PassedControl
Case "PageBreak"
Set pgb = PassedControl
Case "Rectangle"
Set Rec = PassedControl
Case "SubForm"
Set sfm = PassedControl
Case "TabControl"
Set tctl = PassedControl
Case "TextBox"
Set txt = PassedControl
Case "ToggleButton"
Set tgl = PassedControl
End Select
End Property
At the top of the Main Form module place the following code.
Public collControls As Collection
Public cMultipleControls As clsMultipleControls
In the Load event of the Main Form place the following code.
GetCollection Me
At the bottom of the Main Form code place the following recursive public subroutine:
Public Sub GetCollection(frm As Form)
Dim ctl As Control
On Error Resume Next
Set collControls = collControls
On Error GoTo 0
If collControls Is Nothing Then
Set collControls = New Collection
End If
For Each ctl In frm.Controls
If ctl.ControlType = acSubform Then
GetCollection ctl.Form
Else
Set cMultipleControls = New clsMultipleControls
Set cMultipleControls.ctl = ctl
collControls.Add cMultipleControls
End If
Next ctl
end sub
I'd advise giving each control in the form and its subforms a unique name so you can easily utilize the Select statement based on the control name to effectuate processing control in each class module event. For example, each textbox change event will be sent to the txt_change event in the class module where you can use the m_PassedControl.name property in a select statement to direct which code will be executed on the passed control.
The select event is quite useful if you have multiple controls that will receive the same post entry processing.
I use the Main Form Load event rather than the Activate event because a popup form (and its subforms) do not fire the Activate or Deactivate events.
One can also pass the m_PassedControl on to a subroutine in a regular module if you have you have some lengthy processing to accommodate.
Unfortunately, Access does not automatically fire VBA events unless you actually set the event up in the VBA module. So if you want to use a textbox change event you have to make sure the textbox change event is actually set up in applicable vba module. You don't need to add any code to the event, but the empty event must be there or the event and its class module equivalent will not fire. If anyone knows of a work around for this I'd be glad to hear about it.
I found this basic class module structure in an Excel userform code example at http://yoursumbuddy.com/userform-event-class-multiple-control-types/. It's a flexible structure. I have created versions that work with Excel userforms, Excel worksheets with activex controls, and now for Access forms.
Followup Note: The above code works fine with 64 bit Access 2013 on 64 bit Windows 10. But it fails on 64 bit Access 2013 on 64 bit Windows 7 when you try to close the main form. The solution is to move the following code from the main form to a VBA module.
Public collControls As Collection
Public cMultipleControls As clsMultipleControls

Related

How to raise an event from vb6 Form to a usercontrol?

I am trying to RaiseEvent from a button, this button is located in a Form.
Then the idea is to raise the final even to the usercontrol.
I have tried the next code:
Form1
Dim Sec As Integer
Public Event TestEvent()
Private Sub Command1_Click()
RaiseEvent TestEvent
End Sub
usercontrol
Option Explicit
Dim WithEvents f1 As Form1
Dim f2 As Form2
Private Sub f1_TestEvent()
f2.Show
End Sub
Private Sub UserControl_Initialize()
Set f1 = New Form1
f1.Show
Set f2 = New Form2
End Sub
Form2
No code, it is just to verify if the event is raised.
And unfortunately it is not working as I expect.
I hope my question is clear.
Thanks

Returning editable ADO Recordsets to an MS Access Form using a Class Module

PREFACE: I am using SQL Server 2008 R2 BackEnd and MS Access 2007 for the FrontEnd
I have a Class Module that returns any ADO Recordset I want from the SQL Server. I can then assign this to any form RecordSource property.
The problem is that when I try to edit the fields it says "This form is read-only" in the status bar. I want the form to be editable.
I have two forms
FormEntities
FormEntitiesEdit
The FormEntitiesEdit form does NOT use the Class Module. Rather all the code is in the form itself.
The purpose of the class module is avoid redundancy and just be able to use the Class Module to get a recordset from SQL Server easily.
FIRST HERE IS MY GLOBAL MODULE
'Default error message. 'eh' stands for error handler
Public eh As String
'Global variables for universal use
Public conn As ADODB.Connection
Public rs As ADODB.Recordset
Public com As ADODB.Command
SECOND IS THE CLASS MODULE (Name is cADO).
THIS CLASS MODULE USES THE conn CONNECTION OBJECT ABOVE
Option Explicit
Private Const CONST_LockType = 3
Private Const CONST_CursorType = 1
Private Const CONST_CursorLocationServer = 3
Private Const CONST_CursorLocationClient = 2
Private m_Recordset As ADODB.Recordset
'For Public Recordset function
Private cSQL$
'**********************************************************************
Public Function cGetRecordset(ByRef sql) As ADODB.Recordset
Set m_Recordset = New ADODB.Recordset
cSQL = sql
cOpenRecordset
Set cGetRecordset = m_Recordset
End Function
'**********************************************************************
Public Property Set Recordset(Value As ADODB.Recordset)
'Assigns private variable a property
If Not Value Is Nothing Then Set m_Recordset = Value
End Property
'**********************************************************************
Public Property Get Recordset() As ADODB.Recordset
'Reads the recordset from the private variable and assigns to new object variable
Set Recordset = m_Recordset
End Property
'********************************** PRIVATE SECTION **********************************
Private Sub cOpenRecordset()
On Error GoTo eh
'Ensures that if a recordset is opened from previously that it closes before opening a new one
If m_Recordset.State adStateClosed Then m_Recordset.Close
Set m_Recordset.ActiveConnection = conn
With m_Recordset
.LockType = CONST_LockType
.CursorType = CONST_CursorType
.CursorLocation = CONST_CursorLocationClient
.Source = cSQL
.Open .Source
End With
If Not m_Recordset.EOF Then m_Recordset.MoveFirst
Exit Sub
eh:
eh = "Error # " & Str(Err.Number) & " was generated by " & _
Err.Source & Chr(13) & Err.Description
MsgBox eh, vbCritical, "Open Recordset System"
End Sub
'**********************************************************************
Private Sub cCloseRecordset()
m_Recordset.Close
Set m_Recordset = Nothing
End Sub
'**********************************************************************
Private Sub Class_Terminate()
If Not (m_Recordset Is Nothing) Then Set m_Recordset = Nothing
End Sub
THIRD IS THE CODE BEHIND MY FormEntities FORM (USES THE THE cADO CLASS MODULE)
Option Explicit
Dim db As cADO
'**********************************************************************
Private Sub Form_Current()
LoadTab
End Sub
'**********************************************************************
Private Sub Form_Load()
Set db = New cADO
FetchRecordSource
End Sub
'**********************************************************************
Private Sub FetchRecordSource()
db.cGetRecordset ("SELECT * FROM dbo.Entities")
Set Forms("fEntities").Recordset = db.Recordset
End Sub
FOURTH AND FINALLY IS THE CODE BEHIND THE FormEntitiesEdit FORM (THIS FORM DOES NOT USE THE CLASS MODULE AND I CAN EDIT IT)
Option Compare Database
Option Explicit
Dim rsEntity As New ADODB.Recordset
'**********************************************************************
Private Sub Form_Load()
FetchRecordSource
End Sub
'**********************************************************************
Private Sub FetchRecordSource()
Set rsEntity.ActiveConnection = conn
'Sets the record source for the main form
With rsEntity
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.CursorLocation = adUseClient
.Source = "SELECT * FROM dbo.Entities"
.Open .Source
End With
Set Forms("fEntitiesEdit").Recordset = rsEntity
End Sub
'**********************************************************************
Private Sub CloseConn()
rsEntity.Close
End Sub
If Access Jet SQL could do the SQL I would bind this form to a Linked Table instead. However I am using a hierarchical (recursive) query which Jet SQL cannot do so I have to bypass the idea of bound forms to Linked Tables.
I have .Allow Edits and .AllowAdditions on the form set to true.
I also tried changing the .LockType on the ADO Recordset to
adOpenKeyset and
adOpenDynamic
My LockType is adLockOptimistic
As you can see the properties are set correctly to be able to edit the recordset I return.
I know this is true because when I use the FormEntitiesEdit form with the same properties it lets me edit the field. But when I use the Class Module to return (using the same properties) it says it's read-only.
This is important because as you can see it is a lot simpler to use the Class Module, just need it to return an editable recordset.
Anyone have ideas? suggestions?
The problem is here in the class' cOpenRecordset() method:
.CursorLocation = CONST_CursorLocationClient
Here is where you assign constant values ...
Private Const CONST_CursorLocationServer = 3
Private Const CONST_CursorLocationClient = 2
Unfortunately, you swapped those two values. Here are the ADODB.CursorLocationEnum constants ...
adUseClient = 3
adUseServer = 2
So your class is effectively doing this ...
.CursorLocation = adUseServer
But you need a client-side cursor if you want the recordset to be editable. I think your class approach may work if you simply redefine the constant, or you will expose a different problem ...
Private Const CONST_CursorLocationClient = 3
FormEntitiesEdit is editable because you're using the correct constant there ...
.CursorLocation = adUseClient

Listen to property change through Entity Framework AssociationChanged event

I can successfully listen to changes on Entity Framework child EntityCollection if the action is add or delete but cannot find the way to listen to changes if the child class property value was updated.
More specifically, in the below, how can I access the property name that was changed on the child ("Employee") class to run some business logic on the parent ("Company") class?
Public Sub New()
AddHandler Me.employees.AssociationChanged, AddressOf employees_AssociationChanged
End Sub
Private Sub employees_AssociationChanged(ByVal sender As Object, ByVal e As CollectionChangeEventArgs)
Dim act As CollectionChangeAction = e.Action
Dim employeeOnOtherEnd As employee = CType(e.Element, employee)
If Not employeeOnOtherEnd Is Nothing Then
If act = CollectionChangeAction.Add Then
'logic when new employee added
ElseIf act = CollectionChangeAction.Remove Then
'logic when new employee was deleted
End If
'I want to run some business logic here if some employee property value was updated... How to do that?
End If
End Sub
I have INotifyPropertyChanged but I don't want to place any code inside employee class to affect the company class directly. Instead I want to catch the change in company class and run the logic there. I'd like to see the Visual Basic example for this.

Checkbox commanding, check - OK, Uncheck NOT ok, how do i bind the uncheck command?

I'm having problems attaching an uncheck command to a checkbox. Or more correct, I do not know how to code it. Here's my code for the check command, how should it look to get uncheck also working?
View:
<CheckBox commands:Checked.Command="{Binding CheckCommand}"
IsChecked="False"></CheckBox>
ViewModel:
Private _CheckCommand As DelegateCommand(Of Object)
CheckCommand = New DelegateCommand(Of Object)(AddressOf Checked)
Private Sub Checked(ByVal parameter As Object)
End Sub
Command:
Public Class ToggleCheckedCommandBehaviour
Inherits CommandBehaviorBase(Of CheckBox)
Public Sub New(ByVal checkableObject As CheckBox)
MyBase.New(checkableObject)
AddHandler checkableObject.Checked, AddressOf checkableObject_Checked
End Sub
Private Sub checkableObject_Checked(ByVal sender As Object, ByVal e As System.Windows.RoutedEventArgs)
CommandParameter = TargetObject.Name
ExecuteCommand()
End Sub
End Class
Public NotInheritable Class Checked
Private Sub New()
End Sub
Private Shared ReadOnly SelectedCommandBehaviorProperty As DependencyProperty = _
DependencyProperty.RegisterAttached("SelectedCommandBehavior", _
GetType(ToggleCheckedCommandBehaviour), _
GetType(Checked), _
Nothing)
Private Shared ReadOnly CommandProperty As DependencyProperty = _
DependencyProperty.RegisterAttached("Command", _
GetType(ICommand), _
GetType(Checked), _
New PropertyMetadata(AddressOf OnSetCommandCallback))
Public Shared Sub SetCommand(ByVal CheckBox As CheckBox, ByVal command As ICommand)
CheckBox.SetValue(CommandProperty, command)
End Sub
Public Shared Function GetCommand(ByVal CheckBox As CheckBox) As ICommand
Return TryCast(CheckBox.GetValue(CommandProperty), ICommand)
End Function
Private Shared Sub OnSetCommandCallback(ByVal dependencyObject As DependencyObject, ByVal e As DependencyPropertyChangedEventArgs)
Dim CheckBox = TryCast(dependencyObject, CheckBox)
If Not CheckBox Is Nothing Then
Dim behavior = GetOrCreateBehavior(CheckBox)
behavior.Command = TryCast(e.NewValue, ICommand)
End If
End Sub
Private Shared Function GetOrCreateBehavior(ByVal CheckBox As CheckBox) As ToggleCheckedCommandBehaviour
Dim behavior = TryCast(CheckBox.GetValue(SelectedCommandBehaviorProperty), ToggleCheckedCommandBehaviour)
If behavior Is Nothing Then
behavior = New ToggleCheckedCommandBehaviour(CheckBox)
CheckBox.SetValue(SelectedCommandBehaviorProperty, behavior)
End If
Return behavior
End Function
End Class
End Namespace
As mentioned the check command works fine, and the command and method connected to it gets fires, what do I need to do to get the uncheck also working?
For info I'm using PRISM, CAL, MVVM and SL4 - in VB.NET
The fact that the Checked command is working correctly means that the attached behavior was correctly implemented. That said, the behavior only monitors a single event which you specify in this line:
AddHandler checkableObject.Checked, AddressOf checkableObject_Checked
Thus, you are subscribing to the Checked event of the Checkbox control. As you want to have control of the Checkbox being unchecked, you simply need to create another attached behavior using the Unchecked event. This assumes that you want a different command executed when the button is checked/unchecked. If you use the same command, then binding to the Command property should suffice.
I hope this helps.

How to determine if an Entity with relationship properties has changes

Dim myEmployee as Employee = myObjectContext.Employee.Where("it.EmployeeID = 1").First()
The following line will cause e.EntityState to equal EntityState.Modified :
myEmployee.Name = "John"
However, changing a property that is a relationship will leave e.EntityState = EntityState.Unchanged. For example:
myEmployee.Department = myObjectContext.Department.Where("it.DepartmentName = 'Accounting'").First()
How can I tell if myEmployee has changes? I need to know so I can log changes made to the Employee record for auditing purposes.
There is a way to get the state of a relationship, but it is not as easy to obtain as the state of an entity.
ObjectContext.ObjectStateManager.GetObjectStateEntries(System.Data.EntityState state)
returns IEnumerable<ObjectStateEntry> with entries for both, entities and relationships (there is IsRelationship property on ObjectStateEntry so you can determinate if it's relationship or entity).
I tested out with with your example when relationship is changed the way you do
myEmployee.Department = myObjectContext.Department.Where("it.DepartmentName = 'Accounting'").First()
and I find out by calling GetObjectStateEntries for each possible EntityState that one ObjectStateEntry is added with state Added:
myObjectContext.ObjectStateManager.GetObjectStateEntries(System.Data.EntityState.Added)
Now, you can peek at the current values of the state entry to see if they match the ends of the relationship (not nice). However, it's a bit complicated and I'm not sure if it's going to meet your needs in every case.
i was having a similar issue when i was trying to validate in Entity framework:
After researching a little bit i found a solution:
(see im posting the whole validation solution)
Interface for validation:
Interface IValidatable
Function Validate(Optional ByVal guardando As Boolean = False) As List(Of ApplicationException)
End Interface
Handling the SavingChanges event in a partial class:
Partial Class FacturacionEntities
Private Sub FacturacionEntities_SavingChanges(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SavingChanges
Dim objects As New List(Of System.Data.Objects.ObjectStateEntry)
objects.AddRange(Me.ObjectStateManager.GetObjectStateEntries(EntityState.Added))
objects.AddRange(Me.ObjectStateManager.GetObjectStateEntries(EntityState.Modified))
Dim errors As New List(Of ApplicationException)
For Each obj In objects
If obj.IsRelationship Then
Dim fro = DirectCast(obj.CurrentValues(1), EntityKey)
Dim k As New EntityKey("FacturacionEntities." & fro.EntitySetName, fro.EntityKeyValues(0).Key, fro.EntityKeyValues(0).Value)
errors.AddRange(DirectCast(Contexto.Facturacion.GetObjectByKey(k), IValidatable).Validate())
Else
errors.AddRange(DirectCast(obj.Entity, IValidatable).Validate)
End If
Next
If errors.Count > 0 Then
Dim err_list As String = ""
For Each s In errors
err_list = err_list & s.Message & vbCrLf
Next
Throw New ApplicationException(err_list)
End If
End Sub
End Class
Please note than "Contexto.Facturacion" is an instance of the Entities class generated by Entity framework engine.