Define an event for a subdatasheet control

shambalad
shambalad used Ask the Experts™
on
I am working with a subdatasheet on a form. I already have a routine that sets up the column properties (width, order, hidden) as the subdatasheet is being opened. I would like to define MouseUp events for the controls in the subdatasheet. Can this be done? If so, how? I am working with Access 2007.
Thanks,
Todd
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
Top Expert 2007

Commented:
Not quite following ..?
There is already a MouseUp event for each control type.  What are you wanting to do?

mx
Jeffrey CoachmanMIS Liason
Most Valuable Expert 2012

Commented:
<I would like to define MouseUp events for the controls in the subdatasheet.>
For what purpose?

AFAICT, this would create a non-standard interface...
This on top of the dangerous situation you already have by allowing users Access to the tables directly via the subdatesheets...

JeffCoachman

Author

Commented:
boag2000 - you reservations about using a subdatasheet are duly noted and have already been considered. This is a very special circumstance where the use of a subdatasheet makes sense.

MX:
I have a subdatasheet. Within the subdatasheet are mutilple controls. To illustrate what I mean by the multiple controls, I have attached the routines I am using to save and restore the column widths for the subdatasheet. The number of columns are dynamic, they are based on a sourceID which is stored in the table along with the column properties.

Note statement 110 in subroutine 'SaveColumnPropertiesSubDs':        
                             For Each ctl In .Form.Controls
where the .Form.controls is referring to a:
                            <subdatasheet control>.Form.Controls

Of course in this particular sub, I am retrieving the control values.
A subsequent sub 'SetColumnPropertiesSubDs' is the one that sets the control attributes as the subdatasheet is being opened.
As I understand it, Access cannot know how many controls will be until the subdatasheet is opened, so the control attributes must be modified after the subdatasheet has been opened.
Hopefully this illustrates what I mean by defining the controls as the subdatasheet is being opened.
Public Sub SaveColumnPropertiesSubDs(ctlSubDS As Control, lngSourceID As Long)
      Const strProcedure As String = "SaveColumnPropertiesSubDs"
      Dim blnColumnHidden As Boolean
      Dim lngColumnWidth As Long
      Dim lngColumnOrder As Long
      Dim rst As DAO.Recordset
      Dim db As DAO.Database
      Dim strSQL As String
      Dim lngID As Long
      Dim ctl As Control
10    On Error GoTo ErrorHandler

      ' ctlSubDS must be a subdatasheet control
      ' procedure cycles through every control in ctlSubDS and,
      ' if the control is a column, saves its width, column order,
      ' and hidden property.
      ' SourceID identifies the workbook subdatasheet is representing
      
      ' First clear records from table for that source ID
20    strSQL = "DELETE FROM tblDsColumnProperty WHERE SourceID = " & lngSourceID
30    DoCmd.SetWarnings False
40    DoCmd.RunSQL strSQL
50    DoCmd.SetWarnings True

      ' Now add them
60    strSQL = "SELECT ColumnPropertyID, SourceID, dsColumnWidth, dsColumnOrder, " & _
                           "dsColumnHidden, SessionID FROM tblDsColumnProperty WHERE " & _
                           "SourceID = " & lngSourceID & " ORDER BY ColumnPropertyID"
70    Set db = CurrentDb
80    With db
90       Set rst = .OpenRecordset(strSQL)
100      With ctlSubDS
110         For Each ctl In .Form.Controls
120            With ctl
                  ' Check if the control is a column
130               If HasColumn(ctl) Then
140                  lngColumnWidth = Nz(.ColumnWidth, 0)
150                  lngColumnOrder = Nz(.ColumnOrder, 0)
160                  blnColumnHidden = Nz(.ColumnHidden, False)
170                  With rst
180                     .AddNew
190                     .Fields(0) = lngID
200                     .Fields(1) = lngSourceID
210                     .Fields(2) = lngColumnWidth
220                     .Fields(3) = lngColumnOrder
230                     .Fields(4) = blnColumnHidden
240                     .Fields(5) = glngSessionID
250                     .Update
260                  End With    'With rst
270               End If         'If HasColumn(ctl)
280            End With          'With ctl
290            lngID = lngID + 1
300         Next ctl             'For Each ctl In ctlSubDS.Controls
310      End With                'With ctlSubDS
320   End With                   'With db

ExitSub:
330   On Error Resume Next
340   rst.Close
350   Set rst = Nothing
360   Set db = Nothing
370   Set ctl = Nothing
380   On Error GoTo 0
390   Exit Sub

ErrorHandler:
400   HandleError strModule, strProcedure, Err, Err.Description, Erl, "SQL: " & strSQL
410   Resume ExitSub
End Sub

Public Function SetColumnPropertiesSubDs(ctlSubDS As Control, lngSourceID As Long) As Long
      Const strProcedure As String = "SetColumnPropertiesSubDs"
      Dim blnColumnHidden As Boolean
      Dim lngColumnWidth As Long
      Dim lngColumnOrder As Long
      Dim lngTotalWidth As Long
      Dim rst As DAO.Recordset
      Dim db As DAO.Database
      Dim lngID As Long
      Dim strSQL As String
      Dim ctl As Control
      ' Returns total width of subdatasheet control
10    On Error GoTo ErrorHandler
      
      ' ctlSubDS must be a subdatasheet control
      ' procedure reads through table 'tblDsColumnProperty'
      ' For each control that had its properties saved, reset them.
      ' SourceID identifies the workbook subdatasheet is representing

20    strSQL = "SELECT ColumnPropertyID, dsColumnWidth, dsColumnOrder, dsColumnHidden " & _
                           "FROM tblDsColumnProperty WHERE SourceID = " & _
                           lngSourceID & " ORDER BY ColumnPropertyID"
30    Set db = CurrentDb
40    With db
50       Set rst = .OpenRecordset(strSQL)
60       With rst
70          If Not (.BOF And .EOF) Then
80             lngTotalWidth = 100
90             Do Until .EOF
100               lngID = .Fields(0)
110               lngColumnWidth = .Fields(1)
120               lngColumnOrder = .Fields(2)
130               blnColumnHidden = .Fields(3)
140               lngTotalWidth = lngTotalWidth + lngColumnWidth
150               If SetCtl(ctl, ctlSubDS, lngID) Then
160                  With ctl
170                     If HasColumn(ctl) Then
180                        With ctl
190                           .ColumnWidth = lngColumnWidth
200                           .ColumnHidden = blnColumnHidden
210                           If Not lngColumnOrder = 0 Then
220                              .ColumnOrder = lngColumnOrder
230                           End If   'If HasColumn(ctl)
240                        End With    'With ctl
250                     End If         'If HasColumn(ctl)
260                  End With          'With ctl
270               End If               'If SetCtl(ctl, ctlSubDS, lngID)
280               .MoveNext
290            Loop                    'Do Until .EOF
300         End If                     'If Not (.BOF And .EOF)
310      End With                      'With rst
320   End With                      'With db

340   SetColumnPropertiesSubDs = lngTotalWidth
ExitFunction:
350   On Error Resume Next
360   rst.Close
370   Set rst = Nothing
380   Set db = Nothing
390   Set ctl = Nothing
400   On Error GoTo 0
410   Exit Function

ErrorHandler:
420   HandleError strModule, strProcedure, Err, Err.Description, Erl, "SQL: " & strSQL
430   Resume ExitFunction
End Function

Private Function SetCtl(ctl As Control, CtlDs As Control, lngID As Long) As Boolean
On Error GoTo ExitFunction
Set ctl = CtlDs.Form.Controls(lngID)
If Not Err = 0 Then
   GoTo ExitFunction
End If
SetCtl = True
ExitFunction:
On Error GoTo 0
End Function


Public Sub cmdResetColumnProperties(ctlSubDS As Control)
      Const strProcedure As String = "cmdResetColumnProperties"
      Dim ctl As Control
10    On Error GoTo ErrorHandler
      ' Reset columns to default
20    With ctlSubDS
30       For Each ctl In .Controls
40          If HasColumn(ctl) Then
50             With ctl
60                .ColumnOrder = 100   ' i.e. move to last
70                .ColumnHidden = InStr(ctlSubDS.LinkChildFields, .Name)
80                .ColumnWidth = -1   ' default width
90             End With    'With ctl
100         End If         'If HasColumn(ctl)
110      Next ctl          'For Each ctl In .Controls
120   End With             'With ctlSubDS

ExitSub:
130   On Error GoTo 0
140   Exit Sub

ErrorHandler:
150   HandleError strModule, strProcedure, Err, Err.Description, Erl
160   Resume ExitSub

End Sub

Private Function HasColumn(ctl As Control) As Boolean
10    On Error GoTo ExitFunction
20    HasColumn = ctl.ColumnWidth
30    If Not Err = 0 Then
40       GoTo ExitFunction
50    End If
60    HasColumn = True
ExitFunction:
70    On Error GoTo 0
End Function

Open in new window

Success in ‘20 With a Profitable Pricing Strategy

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Author

Commented:
I guess I could use a subform, but it would be more work, and far less elegant....
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
Top Expert 2007

Commented:
Well ... that is a LOT of code to fathom. And back to "I would like to define MouseUp events for the controls in the subdatasheet", still not sure what you mean by that?  Do you  mean programatically ?

mx

Author

Commented:
Yes, I mean programmatically.
That is a lot of code. Sorry, I should have stripped it down.
How's this:

Sub ProcessSubDataSheet()
Dim ctlSubDS As Control
Dim ctl As Control
Dim frm As Form
Set frm = Forms("frmWithSubDatasheet")
Set ctlSubDS = frm.Controls("ctlSubDatasheet")
For Each ctl In ctlSubDS.Form.Controls
   Debug.Print ctl.Name
   ' < set events for this control here >
Next ctl
End Sub

DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
Top Expert 2007

Commented:
What is an example of an event you want to set and the code?

mx

Author

Commented:
This would be using Peter's Software 'Drag-N-Dropper'.
So, for instance, the MouseUp event would be as follows:

Private Sub ctl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
     DD_OnMouseUp Button, Shift, X, Y
End Sub


Author

Commented:
While having this conversation, I've created a new form substituting a standard subform for the subdatasheet, which, I'm pretty sure I can make work. The issue is that the number and widths of the columns will be dynamic. Anyway, this current question is swiftly becoming academic, but it would be good to come to a resolution nonetheless.

Author

Commented:
Just noted in the Help for Peter's Software 'Drag-N-Dropper':
Dropping on datasheets not supported
Oh well...
Now the question really is academic.
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
Top Expert 2007

Commented:
Yeah ... I've asked Peter to add that feature.  Have you tried the reordering feature on List boxes?  Very cool ... I'm using that.

mx

Author

Commented:
Just bought the unlimited, royalty-free distribution license last Friday. This is the first application I've used it with.

Author

Commented:
I'm going to withdraw this question if it's OK with you guys.
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
Top Expert 2007

Commented:
no problem, but re @ http:#a35772298 ... there is a way to do that ... but I'm having a momentary mind blank right now. Bugs me ... will continue to look for it ...

mx

Author

Commented:
No problem - I'll leave this open for a couple of days, just in case it comes to you. For my own edification I'd like to see how it's done.
Thanks
Todd
I don't think this is possible at all. Up to Access 2003, it was possible to trap events of the form, by using a "with events" variable from the main form, but not for actual controls, if I remember correctly. I guess that the controls on a datasheet implement only have a subset of their full form equivalent's features.

Note that even form events are no longer available in Access 2007. It appears that events are only triggered if the form has a module, and a query displayed as sub-datasheet naturally doesn't have one.
Option Explicit

Dim WithEvents frmChild As Form

Private Sub Form_Load()
    Set frmChild = Child0.Form
    frm.OnDblClick = "[Event Procedure]"
End Sub

Private Sub frmChild_DblClick(Cancel As Integer)
    MsgBox "double!"
End Sub

Open in new window


I'm *quite* sure this used to work, but can't test it right now. Anyway, it doesn't in 2007...

However, if you have an actual form displayed as sub-datasheet, you can create event handlers on the fly by using a collection or an array of a class module defining the control's event handler(s).

Cheers!
(°v°)
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
Top Expert 2007

Commented:
"Note that even form events are no longer available in Access 2007. "
Form events are not available ?
No, not without a module. In Access 2003, events are generated even with Form.HasModule=False. That is no longer the case...

(°v°)
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
Top Expert 2007

Commented:
Humm ... I will have to check that out.

Good to see you again Marcus ...

mx
DatabaseMX (Joe Anderson - Microsoft Access MVP)Database Architect / Application Developer
Top Expert 2007

Commented:
So, you are saying that:

frm.OnDblClick = "[Event Procedure]"

Does not work in A2007/10 ... IF ... Has Module is False ?

mx
Yes, that's what I'm saying.

I can't vouch for Access 2010 (they might have fixed that), but I had to add empty modules to several subforms in order to get the events after porting code from 2003 to 2007. In the snippet above, if you change line 7 with  
    frm.OnDblClick = "=MsgBox('hello')"

Open in new window

the message box is displayed... so the events occurs but isn't propagated to "with events" variables expecting them...

So setting OnDblClick to the string "[Event Procedure]" works (there is no error message) but the propagation of the event only occurs if the form also has a module. And again, you can't get a module on a query or form...

BTW: The function call doesn't work for controls on the form (you do get an error message), and it's unsuitable for mouse events: mouse events have parameters which cannot be passed to a function. This would work for other events, without parameters or with only the Cancel parameter, but not for "mouse up".

(°v°)

Author

Commented:
Thank you,
Todd
Welcome and success with your project! -- (°v°)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial