Define an event for a subdatasheet control

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

mx

<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

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

Select allOpen in new window

I guess I could use a subform, but it would be more work, and far less elegant....

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

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

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

mx

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

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.

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.

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

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

I'm going to withdraw this question if it's OK with you guys.

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

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

"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°)

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

Good to see you again Marcus ...

mx

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')"

Select allOpen 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°)

Thank you,
Todd

Welcome and success with your project! -- (°v°)