I am testing my understanding on the if then statement, I wrote a little thing down below but when I hit run, nothing happened. I was expecting a msgbox will appear asking me if I want to quit or not and giving me choices to choose. Did I miss anything please. Thanks
Sub testifthenelse(bQuit As Boolean)
Dim s As String
s = "Do you want to quit?"
If MsgBox(s, vbYesNo, "Quite?") = vbYes Then
bQuit = True
Else
bQuit = False
End If
End Sub
you must call it from another sub:
Sub main()
Dim bQuit As Boolean
testifthenelse bQuit
End Sub
while, if you want to run and test it "by itself" then make the argument optional
Sub testifthenelse(Optional bQuit As Variant)
Dim s As String
s = "Do you want to quit?"
If MsgBox(s, vbYesNo, "Quite?") = vbYes Then
bQuit = True
Else
bQuit = False
End If
End Sub
Related
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
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.
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
I am working on a function for my access database that fills in a form field in my task form automatically based on the data entered in products forms.
Function IsProductReceived(varID As Variant) As String
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim lngTOID As Long
Dim strReceiveDate As Date
Dim bAcceptable As Boolean
On Error GoTo ErrorHandler
If IsNull(varID) Then
IsProductReceived = "TBD"
Else
lngTOID = varID
strSQL = "SELECT tblProduct.TaskID, tblProduct.Received, tblProduct.Acceptable FROM tblProduct WHERE tblProduct.TaskID = " & lngTOID
rst.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
If rst.BOF And rst.EOF Then
IsProductReceived = "TBD"
Exit Function
Else
While rst.EOF = False
If rst![Received] <> "" Then
strReceiveDate = rst![Received]
bAcceptable = rst![Acceptable]
If IsDate(strReceiveDate) Then
If bAcceptable = False Then
IsProductReceived = "YES/NOT ACCEPTED"
Else
IsProductReceived = "YES/ACCEPTED"
End If
Else
IsProductReceived = "NO"
End If
Else
IsProductReceived = "NO"
End If
rst.MoveNext
Wend
End If
rst.Close
Set rst = Nothing
End If
Exit Function
ErrorHandler:
MsgBox Err.Description
Err.Clear
If rst.State = adStateOpen Then
rst.Close
Set rst = Nothing
End If
End Function
There is often more that one product forms related to the task form and products are received at different times. I want the "IsProductReceived = "no" to remain on the task form until ALL products related to the task are received.
This code seems to be working as long as the first product has not been received. I can seem to figure out how to make it remain "no" until all products are received.
I currently am using a while/wend, I have attempted a Do/loop but am still not having satisfactory results. Any help would be much appreciated
How about:
Function IsProductReceived(TaskID) As String
Dim product As New ADODB.Recordset
Dim sql As String
Dim countAll As Integer
Dim countReceived As Integer
Dim countAccepted As Integer
IsProductReceived = "TBD"
If Not IsNumeric(TaskID) Then Exit Function
sql = "SELECT Received, Acceptable FROM tblProduct WHERE TaskID = " & TaskID
product.Open sql, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
While Not product.EOF
countAll = countAll + 1
If IsDate(product!Received) Then countReceived = countReceived + 1
If product!Acceptable Then countAccepted = countAccepted + 1
product.MoveNext
Wend
product.Close
If countAll = 0 Then
IsProductReceived = "No"
ElseIf countAll = countAccepted Then
IsProductReceived = "YES/ACCEPTED"
ElseIf countAll = countReceived Then
IsProductReceived = "YES/NOT ACCEPTED"
Else
IsProductReceived = "No"
End If
End Function
A few notes:
Indent your code better.
Drop the faux Hungarian notation, use descriptive variable names.
Avoid deep nesting, especially when it comes to determining the return value.
Check parameters and exit early if the check fails. This removes nesting depth from the function.
Avoid Variant parameter types unless the function must deal with different data types. Here an Integer or Long type would probably be a better fit. (Using a typed function parameter removes the need for a type check entirely.)
While x = False is an antipattern. Use While Not x.
No need to save recordset fields in local variables first. Just use them directly.
Avoid building SQL from string concatenation. After an IsNumeric() check the above is probably okay, but you really should use parameterized queries.
The issue I'm seeing with your code is that you're getting a record set from a table, looping through the set and testing "Recieved" and then assigning a return value for your function after each test. Effectively, you're just returning the value of the very last record in the recordset. Perhaps instead of setting the value of isProductRecieved inside the While loop, set a bool value to false whenever you encounter a product that hasn't been recieved and then set the return value of the function after the loop:
Dim receive As Boolean
Dim accept As Boolean
receive = True
accept = False
If rst![Received] <> "" Then
strReceiveDate = rst![Received]
bAcceptable = rst![Acceptable]
If IsDate(strReceiveDate) Then
If bAcceptable = False Then
accept = False
Else
accept = True
End If
Else
receive = False
End If
Else
receive = False
End If
So now, if "receive" makes it all the way to the end of your while loop, you know that each product is received but if any product was not received it would be set to false. You could also build a short circuit in there to make it a tiny bit faster.
So I have already solved this problem, though I don't understand why my solution was required. I wanted to make a way to check properties on all forms and all controls within my database so I came up with the following code:
Public Function CheckPropertyAllForms()
Dim obj As Object
Dim ctl As Control
Dim blnFound As Boolean
For Each obj In CurrentProject.AllForms
DoCmd.OpenForm obj.Name, acDesign, , , , acHidden
blnFound = False
For Each ctl In Forms(obj.Name).Controls
On Error GoTo Next_Control
If Nz(ctl.ControlSource, "") <> "" Then
If ctl.ControlSource = "Certain_Field" Then
blnFound = True
End If
End If
Next_Control:
Next ctl
If blnFound = True Then
Debug.Print obj.Name
End If
DoCmd.Close acForm, obj.Name
Next obj
End Function
However this code would only work once, the second time around it would display the error as if error handling was turned off. So I updated it to this:
Public Function CheckPropertyAllForms()
Dim obj As Object
Dim ctl As Control
Dim blnFound As Boolean
For Each obj In CurrentProject.AllForms
DoCmd.OpenForm obj.Name, acDesign, , , , acHidden
blnFound = False
For Each ctl In Forms(obj.Name).Controls
On Error GoTo Err_Handler
If Nz(ctl.ControlSource, "") <> "" Then
If ctl.ControlSource = "Certain_Field" Then
blnFound = True
End If
End If
Next_Control:
Next ctl
If blnFound = True Then
Debug.Print obj.Name
End If
DoCmd.Close acForm, obj.Name
Next obj
Exit_Handler:
Exit Function
Err_Handler:
Resume Next_Control
End Function
Which works exactly how I want it to, however I couldn't find an answer online as to WHY this was happening with my first set of code. Could someone let me know what is happening with my first version of this function to cause the error handling to quit?
Edit: I should also point out that clearly the error handling will be needed because not all controls have a control source. Additionally I don't have a control type check because this function gets updated when a different property is going to be checked.
Along with your On Error statement, you need to have an On Error GoTo 0 statement, too. In your case, it would probably go right before your Next_Control and you could actually get rid of that so your loop would look like this:
For Each ctl In Forms(obj.Name).Controls
On Error Resume Next
If Nz(ctl.ControlSource, "") <> "" Then
If ctl.ControlSource = "Certain_Field" Then
blnFound = True
End If
End If
On Error GoTo 0
Next ctl
The reason for this is that in your first case, the error handler never clears the error object, and there can only be one error active at a time. When an error is active, and another error raises, the handler fails.