I have to create a form based on a table. The table has a Username and then several yes/no fields. This table is used to determine what data a user has access to. There can be a lot of data and since each user cannot have access to the same data I need an easy way to set the field to yes for one person and no for all the others. So I think option group. Not a problem to actually create, but I need to set the value of the option group to the optionvalue of the person that currently has access to the data. There is the problem. VBA gives me an error saying the value of the option group cannot be set in design view which it is in as vba creates the form. It also seems It cannot be set on the on open event of the form so I can't create an (and don't know how to do so if I could) open even to select it on open.
The second problem is hopefully easier. at the end I close and save the form then open it. I need some way to set the forms name on save as I need the form to be named "user_frm".
A note, this is only a test so I could find out what issues there would be with doing this. That said the code is a little sloppy with things just commented out for now as place holders.
Thanks!!
The second problem is hopefully easier. at the end I close and save the form then open it. I need some way to set the forms name on save as I need the form to be named "user_frm".
A note, this is only a test so I could find out what issues there would be with doing this. That said the code is a little sloppy with things just commented out for now as place holders.
Thanks!!
Code:
Sub NewUserFromControl()
Dim frm As Form
Dim ctlLabel() As Control
Dim ctlText() As Control
Dim ctlOption() As Control
Dim ctlOptionGroup() As Control
Dim intX As Integer
Dim intY As Integer
Dim Con As ADODB.Connection
Dim rsTable As ADODB.Recordset
Dim strSQL As String
Dim Count As Long
Dim Count2 As Long
Set Con = CurrentProject.Connection
Set rsTable = New ADODB.Recordset
strSQL = ""
strSQL = strSQL & "Select *"
strSQL = strSQL & " From user_tbl"
rsTable.Open strSQL, Con, adOpenDynamic, adLockOptimistic
' Set positioning values for new controls.
intX = 100
intY = 100
' Create new form
Set frm = CreateForm
Count = 1
Count2 = 1
With rsTable
ReDim Preserve ctlOptionGroup(.Fields.Count) As Control
Do While .EOF <> True
ReDim Preserve ctlLabel(Count) As Control
ReDim Preserve ctlText(Count) As Control
ReDim Preserve ctlOption(Count) As Control
Set ctlLabel(Count) = CreateControl(frm.Name, acLabel, , _
"", !UserName, intX, intY * (Count * 4))
If Count = 1 Then
Set ctlOptionGroup(Count2) = CreateControl(frm.Name, acOptionGroup, , .Fields.Item(1).Name, _
, intX + 1000, (intY * (Count * 4)) - 100)
End If
Set ctlOption(Count) = CreateControl(frm.Name, acCheckBox, , _
ctlOptionGroup(Count2).Name, , intX + 1300, intY * (Count * 4))
ctlOption(Count).OptionValue = .Fields.Item(1).Value
ctlOption(Count).Name = "Test" & Count
If .Fields.Item(1).Value = True Then
'frm.OnOpen = ctlOptionGroup(Count2).OptionValue = Count
End If
Count = Count + 1
.MoveNext
If .EOF = True Then
ctlOptionGroup(Count2).Height = ctlLabel(Count - 1).Top + 100
End If
Loop
End With
' Restore form.
DoCmd.Restore
Dim formname As String
formname = frm.Name
DoCmd.Close acForm, formname, acSaveYes
DoCmd.OpenForm formname
End Sub
[/CODE}