Access VBA - All checkboxes on form have been checked - ms-access

I am relatively new to Access VBA and have a form that has around 30 checkboxes on it. When saving the form I want to ensure that all checkboxes have been ticked (set to true). The tickboxes have all got names SC1, SC2....SCN Is there a way to loop through each control and see if it has been set to true?
This is what I have tried but it doesnt seem to read the tickbox -
Private Sub Validate_Data(rstTop)
Dim n As Integer
Dim count As Integer
count = 0
For n = 1 To rstTop
If Form.Controls("SC" & n).Value = False Then
count = count + 1
End If
Next
If count <> 0 Then
MsgBox "Not all Questions have been ticked, please tick and add comments", vbInformation, _
"More information Required"
Else
End If
End Sub

Give this a try, it worked for me.
Option Compare Database
Option Explicit
Private Function Validate_Data() As Boolean
Dim ctl As Control
Validate_Data = True 'initialize
For Each ctl In Me.Form.Controls
If ctl.ControlType = acCheckBox Then
If (ctl.Name Like "SC*") And (ctl.Value = False) Then
MsgBox "Not all Questions have been ticked, please tick and add comments", vbInformation, _
"More information Required"
Validate_Data = False 'something isnt checked
Exit Function
End If
End If
Next ctl
End Function
Private Sub cmdGo_Click()
Validate_Data
End Sub

Related

Making a form read-only for a certain user type

I have created a login form with a combo box for the user type (Admin, User) and a text box for the password. The code for the form is as follows.
Private Sub txtPassword_AfterUpdate()
If IsNull(Me.cboUser) Then
MsgBox "You need to select a user!", vbCritical
Me.cboUser.SetFocus
Else
If Me.txtPassword = Me.cboUser.Column(2) Then
If Me.cboUser.Column(3) = True Then
MsgBox "Password does not match, please re-enter!", vboOkOnly
Me.txtPassword = Null
Me.txtPassword.SetFocus
End If
DoCmd.OpenForm "FE1"
Me.Visible = False
Else
MsgBox "Password does not match, please re-enter!", vboOkOnly
Me.txtPassword = Null
Me.txtPassword.SetFocus
End If
End If
End Sub
Private Sub cboUser_AfterUpdate()
Forms!frmLogin!cboUser.Column (2)
End Sub
If the log in is as a User, when they get to the FE1 form, I want them just to be able to read the form, and not make any changes. The code I've been trying to use for this is as follows:
Private Sub Form_Open()
If Forms!frmLogin!cboUser.Column(2) = 2 Then
Me.AllowEdits = False
Me.AllowAdditions = False
Me.AllowDeletes = False
Else
Me.AllowEdits = True
Me.AllowAdditions = True
Me.AllowDeletes = True
End If
End Sub
But I keep getting the error:
The expression On Open you entered as the event property setting
produced the following error: Procedure declaration does not
match description of event or procedure having the same name.
*The expression may not result in the name of a macro, the name of a user-defined function, or [Event Procedure].
*There may have been an error evaluating the function, event, or macro.
It's possible I've just been looking at this for too long, but I can't figure out where I've gone wrong!?
Your Form_Open procedure has the wrong signature, missing the Cancel parameter.
It must be:
Private Sub Form_Open(Cancel As Integer)
Don't write event procedures by hand, let Access create them.
Edit
I suggest you completely remove the Form_Open sub. Then let Access create it from the property sheet.
And you can simplify your code by using a variable like this:
Private Sub Form_Open(Cancel As Integer)
Dim AllowWriting As Boolean
AllowWriting = Not (Forms!frmLogin!cboUser.Column(2) = 2)
Me.AllowEdits = AllowWriting
Me.AllowAdditions = AllowWriting
Me.AllowDeletes = AllowWriting
End Sub
or even shorter with the RecordsetType Property:
Private Sub Form_Open(Cancel As Integer)
If Forms!frmLogin!cboUser.Column(2) = 2 Then
Me.RecordsetType = 2 ' Snapshot = read-only
Else
Me.RecordsetType = 0 ' Dynaset = read-write
End If
End Sub

Get user input from optiongroup before proceeding

I have a database that generates test questions in a random order. When I get the answer form (frmAnswers) to open, all I can do is have it scroll through all the questions using either the Enter or esc keys. I have a MsgBox that pops up just to let me know some of the variables are set properly, but the code will not pause to accept input from the OptionGroup in the form.
Here is what I assume is the relevant code:
Set rsCourse = CurrentDb.OpenRecordset(strCourse)
DoCmd.OpenForm ("frmAnswers")
rcdCnt = 1
While Not rsCourse.EOF
With rsCourse
Screen.ActiveForm.ctlQ_No = rcdCnt
Screen.ActiveForm.ctlQuestion = .Fields("Question")
Screen.ActiveForm.ctlAns_A = .Fields("Ans A")
Screen.ActiveForm.ctlAns_B = .Fields("Ans B")
Screen.ActiveForm.ctlAns_C = .Fields("Ans C")
Screen.ActiveForm.ctlAns_D = .Fields("Ans D")
Forms!frmAnswers!optAnswer.SetFocus
Select Case Forms.frmAnswers.optAnswer
Case Is = 1: strAns = "A"
Case Is = 2: strAns = "B"
Case Is = 3: strAns = "C"
Case Is = 4: strAns = "D"
Case Is = Null: srtAns = "Nothing"
End Select
If strAns = .Fields("Correct Answer") Then
Exit Sub
Else
MsgBox "The correct answer is " & .Fields("Correct Answer") _
& Chr(13) & Chr(10) & "You answered " & strAns
End If
End With
rcdCnt = rcdCnt + 1
If rcdCnt > 100 Then
Exit Sub
End If
rsCourse.MoveNext
Wend
I have searched many sites, to include Microsoft, pcreview, accessmvp, etc., and have yet to find anything that helps. I have tried;
Select Case
Case 1
Case 2
Etc.
End Select
as well as the code in my example. Nothing seems to pause the code except the MsgBox.
I have also tried putting this code as a Function:
Call TestClick(strCourse)
With the function:
Function TestClick(strCourse)
with the above code in the function. It returns a compile error: "Object required" at the Set rsCourse line.
I have also tried this as a subroutine with the same error.
For clairification, here is the code I have for the form that calls the frmAnswers Form:
DoCmd.OpenForm ("frmIntroduction_VBA")
If IsNull(Me.cboTrainee_Name) Then ' No Name
MsgBox "You must enter your name to continue!", vbOKOnly ' Tell user
Me.cboTrainee_Name.SetFocus ' Focus the control
Exit Sub ' Exit the method
End If ' End the IsNull test
Trainee_Name = Forms!frmIntroduction_VBA!cboTrainee_Name
If IsNull(Me.cboCourse) Then ' Check if a course is selected
If IsNull(Me.cboVol) Then
MsgBox "You must select either a Course or Volume Review to continue!" ' Tell user
Me.cboCourse.SetFocus
Exit Sub
End If
End If
If IsNull(Me.cboCourse) Then
strCourse = Me.cboVol.Value
Else
strCourse = Me.cboCourse.Value
End If
I would like this to actually call another Sub for the frmAnswers form, but do not know how to pass the rsCourse variable to the Sub.
I am sure this is a fairly easy issue to resolve, but I am no expert by any means. Once I get this problem solved, I will continue on and try to have VBA create a recordset with test results to be appended to an existing table.
Thank you all for any assistance you can provide.
This is just one of a million different ways of doing this. My feelings aren't hurt if other people chime in with other ways. But this solution may be most in-line with the road you're already headed down:
You need a way to pass your strCourse to the form.
-One way would be to declare a String variable strCourse in the frmAnswers class module and set it from the frmIntroduction_VBA after you open frmAnswers.
-Another way would be to create an invisible field on frmAsnwers called strCourse and set it after you open the form with form!frmAnswers!strCourse=strCourse.
-The easiest way I think for you would just be to refer to the frmIntroduction_VBA form from the frmAnswers form. That's what we'll do here.
First things first: Open frmAnswers.
DoCmd.OpenForm("frmAnswers")
Now let's move all the rest of your code into the frmAnswers form itself. Here's the frmAnswers class module:
Option Explicit
'The following will be variables that will persist as long as the form is open
dim rsCourse as Recordset
dim strCourse as String
dim rcdCnt as Long
dim strCorrectAnswer as String
Private Sub Form_Load() 'This basically initializes the variables and loads the first question
If IsNull(Forms!frmIntroduction_VBA!cboCourse) Then
strCourse = Forms!frmIntroduction_VBA!cboVol
Else
strCourse = Forms!frmIntroduction_VBA!cboCourse
End If
Set rsCourse = CurrentDb.OpenRecordset(strCourse)
rcdCnt = 0
LoadNextQuestion
End Sub
Private Sub LoadNextQuestion() 'reusable code to load questions
rcdCnt=rcdCnt+1
If (rcdCnt>100) OR rsCourse.EOF Then
rs.Close
DoCmd.Close acForm, "frmAnswers"
Exit Sub
End If
With rsCourse
ctlQ_No = rcdCnt
ctlQuestion = !Question
ctlAns_A = ![Ans A]
ctlAns_B = ![Ans B]
ctlAns_C = ![Ans C]
ctlAns_D = ![Ans D]
strCorrectAnswer = ![Correct Answer]
optAnswer = Null 'clears previous answer
optAnswer.SetFocus
.MoveNext
End With
End Sub
Private Sub btnSubmit_Click()
Dim strAnswer As String
strAnswer = "Nothing"
Select Case optAnswer
Case 1:
strAnswer = "A"
Case 2:
strAnswer = "B"
Case 3:
strAnswer = "C"
Case 4:
strAnswer = "D"
End Select
If strAns = strCorrectAnswer Then
MsgBox "Correct!"
Else
MsgBox "The correct answer is " & strCorrectAnswer & "." _
& Chr(13) & Chr(10) & "You answered " & strAns &"."
End If
LoadNextQuestion
End Sub
Start with that and play around with it. If you're not sure why I did something a certain or if I missed some fundamental aspect of what you're doing, leave it in a comment and we'll keep refining it.

Find next record based on certain criteria

I am trying to use the .FindNext (and .FindPrevious) function on an update form "next button" to find the record that meets certain criteria.
Private Sub NextRecord_Click()
Dim foundmatch As Boolean
For x = 0 To 3 Step 1
With Me.RecordsetClone
.FindNext "[Sensitivity] = " & [TempVars]![AccessLevel] + x
If .NoMatch Then
foundmatch = False
Else
Me.Bookmark = .Bookmark
foundmatch = True
Exit For
End If
End With
Next
If foundmatch = False Then
MsgBox "No More Records"
End If
End Sub
Upon a user entering the database the users accesslevel is assigned to a temp variable (1 to 4), and each project has a sensitivity rating of 1 to 4. The code below was used and worked for both next and previous only in finding records when the sensitivity and accesslevel were equal but not for sensitivities below the users access level which they are qualified to see.
Private Sub PrevRecord_Click()
Dim Stringy As String
Stringy = "[Sensitivity] = " & [txtaccess]
With Me.RecordsetClone
.FindPrevious Stringy
If .NoMatch Then
MsgBox "No More Records"
Else
Me.Bookmark = .Bookmark
End If
End With
End Sub
Note: The form is pulled from a query with Sensitivity one of the fields, and [txtaccess] is a text box on the field with the default value set at [TempVars]![AccessLevel]. I've also tried changing it to:
Stringy = "[Sensitivity] >= " & [txtaccess]
but that doesn't work either
I was able to fix the problem by setting applying a filter for sensitivity on the actual forms On_Load event rather than the command button. It now works using a next record command button added with the default code/settings!

How to create controls at run time Access VB?

How can you create controls at run time with VB code in Microsoft Access? after some digging I found that this is possible with the CreateControl function. The problem is every random forum I find online has some code similar to this:
Private Sub Button_Click()
Call AddLabel
End Sub
Function AddLabel()
Set ctl = CreateControl("MyForm", acLabel, acDetail, "", "", 0, 0, 100, 100)
With ctl
.name = "myTextBox"
.Caption = "Hello World!"
.Height = 50
.Width = 100
.FontSize = 11
.Visible = True
End With
End Function
but this code appears to not create a visible label.
In my case I'm just trying to learn how to get this to work. So I created a blank form with a button that when clicked will create a label that says "Hello world!". What I'm expecting to happen is a textbox will display in the top left of the form when the button is clicked. I'm curious if anyone could help show me a simple example of some code that actually works.
Before anyone says I can create a label and hide it then change its visibilty property, I know. But I'd like to know how to create controls dynamically and getting this simple example to actually work will greatly help my understanding.
The documentation you need is here (these are specifically for Access VBA):
Application.CreateControl Method (Office 2007)
Application.CreateControl Method (Office 2003)
According to the documentatin, there are some big limitations to this feature:
Limited to 754 controls over the lifetime of the form (this is not reset by deleting them, so you are likely to run into this limit quickly)
Must be done in Design view (so it can't be done in mde/accde)
It is questionable how it will perform in a multi-user environment.
Because of these limitations, it is inadvisable, unless you are using to design forms initially.
Duplicate Question: How do you dynamically create controls on a MS Access form?
In response to the OP's suggestion, here is my test code which was able to add 40 controls and repeat the process 50 times without exceeding the 754 limit (I reused 40 names in my test).
Caveat 1 This is inadvisable because it can only be done in design view which will not work in an mde/accde.
Caveat 2: It is questionable how it will perform in a multi-user environment.
This code is from a form with two buttons. It opens a second form named "Form2"
Option Compare Database
Option Explicit
Private Const FORM_NAME As String = "Form2"
Private m_nCounter As Long
Private Sub cmdCreate_Click()
runDynamicForm
End Sub
Private Sub cmdRepeat_Click()
Dim n As Long
m_nCounter = 0
For n = 0 To 50
runDynamicForm
DoEvents
DoCmd.Close acForm, FORM_NAME, acSaveNo
DoEvents
Next 'n
MsgBox m_nCounter
End Sub
Private Sub runDynamicForm()
Const DYNAMIC_TAG As String = "dynamic"
Dim n As Long
Dim frm As Form
Dim ctl As Access.Control
On Error GoTo EH
Application.Echo False
DoCmd.OpenForm FORM_NAME, acDesign
Set frm = Application.Forms(FORM_NAME)
For n = frm.Controls.Count - 1 To 0 Step -1
Set ctl = frm.Controls(n)
If ctl.Tag = DYNAMIC_TAG Then
Application.DeleteControl FORM_NAME, ctl.Name
End If
Next 'n
For n = 1 To 20
With Application.CreateControl(FORM_NAME, acLabel, acDetail, , , 400, n * 300, 1500, 300)
.Name = "lbl" & n
.Caption = "Question " & n
.Visible = True
.Tag = DYNAMIC_TAG
End With
With Application.CreateControl(FORM_NAME, acTextBox, acDetail, , , 2000, n * 300, 3000, 300)
.Name = "txt" & n
.Visible = True
.TabIndex = n - 1
.Tag = DYNAMIC_TAG
End With
m_nCounter = m_nCounter + 2
Next 'n
DoCmd.Close acForm, FORM_NAME, acSaveYes
DoCmd.OpenForm FORM_NAME, acNormal
GoTo FINISH
EH:
With Err
MsgBox "Error:" & vbTab & .Number & vbCrLf _
& "Source" & vbTab & .Source & vbCrLf _
& .Description
End With
FINISH:
Application.Echo True
End Sub
I took that upove code and simplified it as it was long winded, and turned it into a a sample code for my own future use. Hope it helps someone in the future.
Public Sub runDynamicCreateControls()
Dim FormName As String
Dim NumControls As Integer
Dim n As Long
Dim ctl As Access.Control
Dim ctlname As String
On Error GoTo EH
Application.Echo False
FormName = "createcontrolF" 'Input Name of Form
NumControls = 20 'input number of controls
ctlname = "txt" 'input control name
DoCmd.OpenForm FormName, acDesign
For n = 1 To NumControls
With Application.CreateControl(FormName, acTextBox, acDetail, , , 1000,1000, 1100, 600)
.Name = ctlname & "_" & n
.Visible = True
.Tag = n
End With
Next 'n
DoCmd.Close acForm, FormName, acSaveYes
DoCmd.OpenForm FormName, acNormal
GoTo FINISH
EH:
With Err
MsgBox "Error:" & vbTab & .Number & vbCrLf _
& "Source" & vbTab & .Source & vbCrLf _
& .Description
End With
FINISH:
Application.Echo True
End Sub
Whenever I attempt to run your code I get the runtime error of:
Run-time error '6062':
You must be in Design or Layout View to create or delete controls.
Based off of that information it seems like dynamically creating controls in runtime isn't going to be possible.
You might be only missing DoCmd.Restore, here is an example on how to dynamically create form, data bind it, and create controls, all in runtime.
Sub NewControls()
Dim frm As Form
Dim ctlLabel As Control, ctlText As Control
Dim intDataX As Integer, intDataY As Integer
Dim intLabelX As Integer, intLabelY As Integer
' Create new form with Orders table as its record source.
Set frm = CreateForm
frm.RecordSource = "Orders"
' Set positioning values for new controls.
intLabelX = 100
intLabelY = 100
intDataX = 1000
intDataY = 100
' Create unbound default-size text box in detail section.
Set ctlText = CreateControl(frm.Name, acTextBox, , "", "", _
intDataX, intDataY)
' Create child label control for text box.
Set ctlLabel = CreateControl(frm.Name, acLabel, , _
ctlText.Name, "NewLabel", intLabelX, intLabelY)
' Restore form.
DoCmd.Restore
End Sub

Why is my .setfocus ignored?

I have an Access form with a textbox that is meant to allow for repeatedly typing a number, hitting enter, and letting a script do stuff. For speed, the field should keep the focus after DoStuff() is done.
However, while I'm sure that DoStuff() is run, the focus always goes to the next field in the tab order. It's like Me.MyFld.SetFocus is being ignored.
How do I keep the focus on this field after DoStuff() is done?
Private Sub MyFld_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
DoStuff
Me.MyFld.SetFocus
End If
End Sub
If you look at the order of events for a keypress that would change focus, you can see that it always follows this pattern:
KeyDown → BeforeUpdate → AfterUpdate → Exit → LostFocus
You can re-set the focus anywhere in there and it will still keep following the pattern. So we need to tell it to stop following the pattern. Replace your Me.MyFld.SetFocus with DoCmd.CancelEvent and it should fix your problem. Basically, this just kicks you out of the above pattern, so the Exit and LostFocus events never fire...
A workaround is moving the focus to another control and then back to the first control. Like this:
Private Sub MyFld_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
DoStuff
Me.anotherControl.SetFocus
Me.MyFld.SetFocus
End If
End Sub
click on access options
select Advanced
select Don't move from Move after enter
click ok
It will work 100%
Try removing the whole line for variable_name.SetFocus and simply add:
Cancel = True
Private Sub MyFld_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
DoStuff
Cancel = True
End If
End Sub
Another solution to the problem that I use in Excel.
Let there exist UserForm1 with the TextBox1 and CommandButton1 controls.
Code in the form module:
Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyReturn Then
'Call DoStuff
Application.OnTime Now, "'Control_SetFocus """ & Me.Name & """, """ & Me.ActiveControl.Name & """ '"
' The concatenation returns a string: 'Control_SetFocus "UserForm1", "TextBox1"'
End If
End Sub
And code in the standard module:
Option Explicit
Sub Control_SetFocus(FormName As String, ControlName As String)
Dim oUserForm As Object
Set oUserForm = GetFormByName(FormName)
If Not oUserForm Is Nothing Then
oUserForm.Controls(ControlName).SetFocus
End If
End Sub
Function GetFormByName(FormName As String) As Object
Dim oUserForm As Object
On Error GoTo ErrHandle
For Each oUserForm In VBA.UserForms
If StrComp(oUserForm.Name, FormName, vbTextCompare) = 0 Then
Exit For
End If
Next oUserForm
If oUserForm Is Nothing Then
Set oUserForm = UserForms.Add(FormName)
End If
Set GetFormByName = oUserForm
Exit Function
ErrHandle:
Select Case Err.Number
Case 424:
MsgBox "Userform " & FormName & " not exists.", vbExclamation, "Get userform by name"
Case Else:
MsgBox Err.Number & ": " & Err.Description, vbCritical, "Get userform by name"
End Select
End Function
Artik
An easy solution that works in Excel is to set the KeyCode to 0. If DoStuff steals the focus then you should also set the focus back:
Private Sub MyFld_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
DoStuff
KeyCode = 0
Me.MyFld.SetFocus
End If
End Sub