Teddy said:
I have a form named frmForm1 which is linked to two tables
called tblTable1
and tblTable2; tblTable2 is linked to the subform while
tblTable1 is linked
to the main form. I have a command button on the form,
when I click it I
would like for it to jump to and/or select one random
record from tblTable1
and display it in the main form field in frmForm1 while
simultaneously
jumping to and/or selecting 3 random records from
tblTable2 and displaying
them in the subform field in frmForm1. The tables are not
linked. Do you
know what code would enable me to do this?
This is possible.
I had to do it using the following.
Put two subform controls on one unbound form.
The first subform control should contain the form for
tblTable1 and the second subform control should contain the
form for tblTable2.
The name of the subform control is not necessarily the same
as the name of the form in the subform control. Select the
subform control, open its properties sheet, and examine the
Name property. Ensure you get the names of the subform
controls in the constants at the top of the code.
You need a primary key field in each table. I used
Autonumber fields with the field names ID1 and ID2.
I used SQL statements as the recordsources of the forms for
tables 1 and 2. Its easy to adjust SQL statements to select
just one record in subform control 1 and three records in
subform control 2.
Below is the code I used in the module behind the unbound
form.
Copy and paste the code into an unbound form.
Adjust the constants at the top to reflect your solution.
Option Compare Database
Option Explicit
' Requires reference to Microsoft DAO
' (In VBA editor, Tools > References > Microsoft DAO.)
' Assumes:
' Main form is unbound.
' Main form contains 2 subform controls.
' CONSTANTS
' Store names of subform controls
' containing 1st and 2nd subforms:
Private Const mstrcSFrm1 As String = "SubFrmCtrlTable1"
Private Const mstrcSFrm2 As String = "SubFrmCtrlTable2"
' Store RecordSource SQL statements
' for 1st and 2nd subforms:
Private Const mstrcSQL1 As String = "SELECT tblTable1.* " _
& "FROM tblTable1;"
Private Const mstrcSQL2 As String = "SELECT tblTable2.* " _
& "FROM tblTable2;"
' Store names of primary key fields
' for 1st and 2nd tables:
Private Const mstrcPKFieldName1 As String = "ID1"
Private Const mstrcPKFieldName2 As String = "ID2"
Private Sub cmdSelect_Click()
Dim objSF1 As Access.SubForm
Dim objRS1 As DAO.Recordset
Dim objSF2 As Access.SubForm
Dim objRS2 As DAO.Recordset
Dim strFirstBookMark1 As String
Dim strFirstBookMark2 As String
' To store primary keys:
Dim lngPK1 As Long
Dim lngPK2a As Long
Dim lngPK2b As Long
Dim lngPK2c As Long
Dim lngRecordCount1 As Long
Dim lngRecordCount2 As Long
Dim lngRecord1 As Long
Dim lngRecord2a As Long
Dim lngRecord2b As Long
Dim lngRecord2c As Long
Dim strSQL As String
On Error GoTo Error_cmdSelect_Click
' PROCESS SUBFORM 1:
Set objSF1 = Me.Controls(mstrcSFrm1)
objSF1.Form.RecordSource = mstrcSQL1
Set objRS1 = objSF1.Form.Recordset
With objRS1
If .RecordCount > 0 Then
' After the form is opened, the first
' record may not be the current record,
' therefore:
.MoveFirst
strFirstBookMark1 = .Bookmark
' Get accurate record count:
.MoveLast
lngRecordCount1 = .RecordCount
.MoveFirst
' Calculate and move to random
' record number:
lngRecord1 = Int(lngRecordCount1 * Rnd)
.Move lngRecord1, strFirstBookMark1
' Get primary key of current record:
lngPK1 = .Fields(mstrcPKFieldName1).Value
' Show only the current record:
strSQL = Left(mstrcSQL1, Len(mstrcSQL1) - 1)
strSQL = strSQL _
& " WHERE " & mstrcPKFieldName1 _
& "=" & lngPK1 & ";"
objSF1.Form.RecordSource = strSQL
Else
MsgBox "Cannot move in main table. " _
& "No Records."
End If
End With
' PROCESS SUBFORM 2:
Set objSF2 = Me.Controls(mstrcSFrm2)
objSF2.Form.RecordSource = mstrcSQL2
Set objRS2 = objSF2.Form.Recordset
With objRS2
If .RecordCount > 0 Then
' After the form is opened, the first
' record may not be the current record,
' therefore:
.MoveFirst
strFirstBookMark2 = .Bookmark
' Get accurate record count:
.MoveLast
lngRecordCount2 = .RecordCount
.MoveFirst
' Calculate and move to 1st random
' record number:
lngRecord2a = Int(lngRecordCount2 * Rnd)
.Move lngRecord2a, strFirstBookMark2
' Get primary key of current record:
lngPK2a = .Fields(mstrcPKFieldName2).Value
' Calculate and move to 2nd random
' record number:
lngRecord2b = Int(lngRecordCount2 * Rnd)
.Move lngRecord2b, strFirstBookMark2
' Get primary key of current record:
lngPK2b = .Fields(mstrcPKFieldName2).Value
' Calculate and move to 3rd random
' record number:
lngRecord2c = Int(lngRecordCount2 * Rnd)
.Move lngRecord2c, strFirstBookMark2
' Get primary key of current record:
lngPK2c = .Fields(mstrcPKFieldName2).Value
' Show only the current record:
strSQL = Left(mstrcSQL2, Len(mstrcSQL2) - 1)
strSQL = strSQL _
& " WHERE " & mstrcPKFieldName2 _
& " IN (" & lngPK2a _
& ", " & lngPK2b _
& ", " & lngPK2c & ");"
objSF2.Form.RecordSource = strSQL
Else
MsgBox "Cannot move in sub-table. " _
& "No Records."
End If
End With
Exit_cmdSelect_Click:
Set objRS2 = Nothing
Set objSF2 = Nothing
Set objRS1 = Nothing
Set objSF1 = Nothing
Exit Sub
Error_cmdSelect_Click:
MsgBox "Error No: " & Err.Number _
& vbNewLine _
& Err.Description, _
vbOKOnly + vbExclamation, _
"Error Information"
Resume Exit_cmdSelect_Click
End Sub
Private Sub cmdShowAll_Click()
Dim objSF1 As Access.SubForm
Dim objSF2 As Access.SubForm
Set objSF1 = Me.Controls(mstrcSFrm1)
Set objSF2 = Me.Controls(mstrcSFrm2)
objSF1.Form.RecordSource = mstrcSQL1
objSF2.Form.RecordSource = mstrcSQL2
Exit_cmdShowAll_Click:
Set objSF1 = Nothing
Set objSF2 = Nothing
Exit Sub
Error_cmdShowAll_Click:
MsgBox "Error No: " & Err.Number _
& vbNewLine _
& Err.Description, _
vbOKOnly + vbExclamation, _
"Error Information"
Resume Exit_cmdShowAll_Click:
End Sub
Private Sub Form_Load()
Dim objSF1 As Access.SubForm
Dim objSF2 As Access.SubForm
' Put SQL statements into RecordSource
' property of forms in SubForm controls.
Set objSF1 = Me.Controls(mstrcSFrm1)
objSF1.Form.RecordSource = mstrcSQL1
Set objSF2 = Me.Controls(mstrcSFrm2)
objSF2.Form.RecordSource = mstrcSQL2
Exit_Form_Load:
Set objSF2 = Nothing
Set objSF1 = Nothing
Exit Sub
Error_Form_Load:
MsgBox "Error No: " & Err.Number _
& vbNewLine _
& "Error Description:" & vbNewLine _
& Err.Description, vbOKOnly + vbExclamation, _
"Error Information"
Resume Exit_Form_Load
End Sub
Private Sub Form_Open(Cancel As Integer)
Randomize
End Sub
Geoff
