Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Two problems with creating a form based on a table in VBA

Status
Not open for further replies.

Sorwen

Technical User
Nov 30, 2002
1,641
US
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!!
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}
 
There is an error in the above.

Code:
ctlOption(Count).OptionValue = .Fields.Item(1).Value

Should be
Code:
ctlOption(Count).OptionValue = Count
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top