I set up the following public function to help me lock and enable(false) or vise versa, specific controls on a form. This way I can lock/enable them all, or I can unlock and enable the A group or B group, depending on a combo box chosen. I set this up, and it seems the locked is working, but not the NOT enabled.
I am passing which group of controls to flip, and then a boolean to lock them as true or false. The enabled properties of those controls should be the inverse of the boolean variable or NOT of the variable.
Can someone please see what I may need to adjust?
Public Function CostModelLock(LockType As String, LockOn As Boolean)
Select Case LockType
Case "A"
'Lock A controls
Forms!frmRequest.AField1.Locked = LockOn
Forms!frmRequest.AField2.Locked = LockOn
Forms!frmRequest.AField3.Locked = LockOn
'Enable A controls
Forms!frmRequest.AField1.Enabled = Not LockOn
Forms!frmRequest.AField2.Enabled = Not LockOn
Forms!frmRequest.AField3.Enabled = Not LockOn
Case "B"
'Lock B controls
Forms!frmRequest.BField1.Locked = LockOn
Forms!frmRequest.BField2.Locked = LockOn
Forms!frmRequest.BField3.Locked = LockOn
'Enable B controls
Forms!frmRequest.BField1.Enabled = Not LockOn
Forms!frmRequest.BField2.Enabled = Not LockOn
Forms!frmRequest.BField3.Enabled = Not LockOn
End Select
Forms!frmRequest.Repaint
End Function
Edit - Continue:
Yes, I am trying to lock it and disabling grays it out. I could just flip visibility, but I was trying to avoid that, so the user could fill out both, if it applied, but only have 1 set active at a time. I want the ones that are not the option they chose, to be grayed out, so it is clear that those fields are not in play. I have a combo box, which is how the user chooses which set they need and this function runs in the after update of that combo.
On load of the form I have this function run on both sets, to make sure they are locked. That is because the form loads with no records. They have to use a combo to find a request, or click new to start a new one. In the after update, I have the following code:
If Nz(Me.FKCostModelType.Value) <> 0 Then
If Me.FKCostModelType.Column(0) = 1 Then
Call CostModelLock("A", False)
Call CostModelLock("B", True)
ElseIf Me.FKCostModelType.Column(0) = 2 Then
Call CostModelLock("B", False)
Call CostModelLock("A", True)
End If
ElseIf Nz(Me.FKCostModelType.Value) = 0 Then
Call CostModelLock("A", True)
Call CostModelLock("B", True)
End If
I tried switching the function order around to disable and then lock, but that didn't work either. I will also add the above code to the find request, so that once a request is found, that section is set properly. I have updated the originally posted code above, to add a variable that is set by an if statement to set the inverse of the boolean that is passed to the function, so I can more easily pass the opposite boolean to the control.
Public Function CostModelLock(LockType As String, LockOn As Boolean)
Dim NotLockOn As Boolean
If LockOn = True Then
NotLockOn = False
Else
NotLockOn = True
End If
Select Case LockType
Case "A"
'Enable A controls
Forms!frmRequest.AField1.Enabled = NotLockOn
Forms!frmRequest.AField2.Enabled = NotLockOn
Forms!frmRequest.AField3.Enabled = NotLockOn
'Lock A controls
Forms!frmRequest.AField1.Locked = LockOn
Forms!frmRequest.AField2.Locked = LockOn
Forms!frmRequest.AField3.Locked = LockOn
Case "B"
'Enable B controls
Forms!frmRequest.BField1.Enabled = NotLockOn
Forms!frmRequest.BField2.Enabled = NotLockOn
Forms!frmRequest.BField3.Enabled = NotLockOn
'Lock B controls
Forms!frmRequest.BField1.Locked = LockOn
Forms!frmRequest.BField2.Locked = LockOn
Forms!frmRequest.BField3.Locked = LockOn
End Select
Forms!frmRequest.Repaint
End Function
It's not a huge deal. I may just remove the enabled property settings and see if I can just gray them out, like the enabled property does.
Thank you all for the responses! It helps a lot to get advice from developers who are really good at all of this.
Continued Again:
ok, so I have rewritten it again, but its still not working how I want and I am not sure what I am doing wrong. below is the public function, and then the after update of the combo, where a user chooses the model they want, and this function fires off to set the 2 groups of controls appropriately.
Public Function Code:
Public Function CostModelLock(TagType As String, LockOn As Boolean)
Dim frm As Form
Dim ctl As Control
Dim bColor As String
Set frm = Forms!frmRequest
If LockOn = True Then
bColor = RGB(192, 192, 192)
Else
bColor = vbWhite
End If
'Loop through every control on the form
For Each ctl In frm.Controls
'Look for a Particular Tag
If ctl.Tag = TagType And (TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox) Then
ctl.Locked = LockOn
ctl.BackColor = bColor
End If
Next ctl
frm.Repaint
End Function
After Update of combo to fire public function:
Private Sub FKCostModelType_AfterUpdate()
If Nz(Me.FKCostModelType.Value) <> 0 Then
If Me.FKCostModelType.Column(0) = 1 Then
Call CostModelLock("ReqA", False)
Call CostModelLock("ReqB", True)
ElseIf Me.FKCostModelType.Column(0) = 2 Then
Call CostModelLock("ReqB", False)
Call CostModelLock("ReqA", True)
End If
ElseIf Nz(Me.FKCostModelType.Value) = 0 Then
Call CostModelLock("ReqA", True)
Call CostModelLock("ReqB", True)
End If
Call UpdateCostEstimate
End Sub
I also have code in a combo to find a record. That is this:
Private Sub cboFindRequest_AfterUpdate()
Dim ctl As Control
Me.RecordSource = "SELECT * FROM tblRequest"
With Me.RecordsetClone
.FindFirst "ID = " & _
Me.cboFindRequest.Column(0)
If Not .NoMatch Then
Me.Bookmark = .Bookmark
'Set detail, footer and save button visible
Me.Detail.Visible = True
Me.FormFooter.Visible = True
Me.cmdSave.Visible = True
'Set new record and cancel not visible
Me.cmdNew.Visible = False
Me.cmdCancel.Visible = False
'setErr formats red borders around controls, and this is set to false, to remove any red borders
For Each ctl In Forms!frmSoftwareRequest.Controls
setErr ctl, False
Next ctl
'Set focus on first field, so find combo doesn't have focus and can be set to not visible
Me.RequestName.SetFocus
Me.cboFindRequest.Visible = False
Me.Requery
'call the after update function from above
FKCostModelType_AfterUpdate
'call a function to update a calculated control on form
UpdateCostEstimate
End If
End With
End Sub
2 things are going wrong right now - one is that the controls aren't getting locked properly. I use the combo to find a request, and then scroll down to the section with the combo to choose a cost model. When I try to change that combo, the second issue happens. I get an error : The data has been changed. Another user edited this record and saved the changes before you attempted to save your changes. Re-edit the record.
Ugh. I'm sure I'm doing 10 things wrong, but I can't seem to figure out what. The first function in this new edit (CostModelLock) I think the issue there is the frm and ctl calls I have been doing a debug.print and such, but not seeing what I would expect to happen. I can give more info, but not sure what to provide. Help is really appreciated!
If, as Hans noted, none of the controls has focus, your code should work, so - most likely - something else is going on.
As a sidenote, your code can be reduced to:
Public Function CostModelLock(LockType As String, LockOn As Boolean)
Dim Index As Integer
For Index = 1 to 3
With Forms!frmRequest(LockType & "Field" & CStr(Index))
.Locked = LockOn
.Enabled = Not LockOn
End With
Next
Forms!frmRequest.Repaint
End Function
I got it! I am answering my own question, so that I can put my whole code out here, in case it helps someone else. I will also mark up Gustav's answer, since it led me here.
First, This is the final public function, which disables and locks each control that has the tag property set to the value passed through the TagType, and is a text box or a combo box.
Public Function CostModelLock(TagType As String, LockOn As Boolean)
Dim ctl As Control
Dim bColor As String
Dim NotLockOn
If LockOn = True Then
NotLockOn = False
Else
NotLockOn = True
End If
If LockOn = True Then
bColor = RGB(192, 192, 192)
Else
bColor = vbWhite
End If
'Loop through every control on the form
For Each ctl In Forms!frmRequest.Controls
Debug.Print ctl.Name
If ctl.Tag = TagType Then
Debug.Print ctl.Tag
If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then
Debug.Print Nz(ctl.ControlType, 0)
Debug.Print ctl.Locked
ctl.Enabled = NotLockOn
ctl.Locked = LockOn
ctl.BackColor = bColor
Debug.Print ctl.Locked
End If
Else
Debug.Print ctl.Tag
End If
Next ctl
Forms!frmSoftwareRequest.Repaint
End Function
I have a redundant enable and back color going on, but that won't hurt anything. I will likely remove the back color part, but not concerned too much right now.
The afterupdate of a combo on the form now calls a public function, so that I can call this other function whereever I need:
Public Function ActiveCostModel()
If Nz(Forms!frmRequest.FKCostModelType.Value) <> 0 Then
If Forms!frmRequest.FKCostModelType.Column(0) = 1 Then
CostModelLock "ReqCostA", False
CostModelLock "ReqCostB", True
ElseIf Forms!frmRequest.FKCostModelType.Column(0) = 2 Then
CostModelLock "ReqCostB", False
CostModelLock "ReqCostA", True
End If
ElseIf Nz(Forms!frmRequest.FKCostModelType.Value) = 0 Then
CostModelLock "ReqCostA", True
CostModelLock "ReqCostB", True
End If
Call UpdateCostEstimate
End Function
And the best part --> It all works! Thank you so much #Gustav and everyone else for all your responses and help!
Related
I am currently working on adding an audit trail to a MS-Access 2010 database and I am struggling with
"error 3251 : operation is not supported for this type object"
Here is the code of my audit trail module, mostly arranged code coming from web :
Public Function auditChanges(RecordID As String, userAction As String, cForm As Form)
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim ctl As Control
Dim userLogin As String
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT * FROM T_AUDIT")
userLogin = getCurrentUser
Select Case userAction
Case "New"
With rst
.AddNew
![Date] = Now()
![utilisateur] = userLogin
![nomFormulaire] = cForm.Name
![Action] = userAction
![RecordID] = cForm.Controls(RecordID).Value
.Update
End With
Case "Delete"
With rst
.AddNew
![Date] = Now()
![utilisateur] = userLogin
![nomFormulaire] = cForm.Name
![Action] = userAction
![RecordID] = cForm.Controls(RecordID).Value
.Update
End With
Case "Edit"
For Each ctl In cForm.Controls
If (ctl.ControlType = acTextBox) Or (ctl.ControlType = acComboBox) Or (ctl.ControlType = acCheckBox) Then
If (Nz(ctl.Value, "") <> Nz(ctl.OldValue, "")) Then
With rst
.AddNew
![Date] = Now()
![utilisateur] = userLogin
![nomFormulaire] = cForm.Name
![Action] = userAction
![RecordID] = cForm.Controls(RecordID).Value
![champs] = ctl.ControlSource
![ancienneValeur] = ctl.OldValue
![nouvelleValeur] = ctl.Value
.Update
End With
End If
End If
Next ctl
End Select
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
End Function
This function is called in beforeUpdate event of the forms I want to track.
The error is fired when I try to edit a bound textbox. And the line If (Nz(ctl.Value, "") <> Nz(ctl.OldValue, "")) Then is the line provoking the error
The form is based on 2 tables linked with a One-To-Many relationship. The function is working when I edit fields from the table which are sided to the "One" part of the relationship but it throws the error when I want to edit fields from the "Many" side.
I hope I am clear enough, thank you
Edit : More details
My form is based on that request :
SELECT T_REVISION.ID_revision, T_REVISION.fk_ID_proposition, T_REVISION.numero, T_REVISION.fk_etat_revision, T_REVISION.EOTP, T_PROPOSITION.reference_simple, T_PROPOSITION.libelle, T_REVISION.description_localisation
FROM T_PROPOSITION INNER JOIN T_REVISION ON T_PROPOSITION.ID_proposition = T_REVISION.fk_ID_proposition
ORDER BY T_REVISION.numero DESC;
The error is fired from T_PROPOSITION.reference_simple control.
The error 3251 occurs when : I try to edit T_REVISION.EOTP, T_REVISION.description_localisation fields. The error 3251 does not occur when I edit T_PROPOSITION.reference_simple, T_PROPOSITION.libelle !
So : I'am able to edit values coming from the "One" side of the relation but when I want to edit the "Many" side it seems I can't access the oldValue property
How can I solve this ?
Not exactly an answer, but the comment area is not suitable...
If would add 2 lines BEFORE the If (Nz(ctl.Value, "") <> Nz(ctl.OldValue, "")) Then
:
debug.print ctl.Name, ctl.value
debug.print ctl.name, ctl.oldvalue
This will allow you to see if the error is linked to a specific control and to a specific property, and narrow your search.
Edit: After you edited your OP indicating that the issue arises on the "many" side of you join, I think you should change your form to a "main form - subform" architecture. This will allow you to track updates to each TABLE correctly.
It's hard to tell exactly what's causing the error when you don't specify the line that's popping up the error, but there is one obvious possibility.
You're trapping for Null in your control loop
If (Nz(ctl.Value, "") <> Nz(ctl.OldValue, "")) Then
And more importantly you're missing a front parentheses as " ("
But then you don't trap for that possibility when assigning the control's value and old value to your recordset.
![ancienneValeur] = ctl.OldValue
![nouvelleValeur] = ctl.Value
Do your fields ancienneValeur and nouvelleValeur allow for null or zero length fields to be assigned to them?
In any case you should be consistent and make sure you trap for null values before assigning them to your table's fields.
![ancienneValeur] = NZ(ctl.OldValue,"")
![nouvelleValeur] = NZ(ctl.Value,"")
I have a huge form in access which needs to prevent users from editing the details in it.. I have done that by setting Me.Allowedits to false. But there is one field which I need to keep as open to editing. To do this I have jus placed the code to open the field after the allowedits part in two places where the allowedit code occurs. the flow on debugging was like this
Load
Me.allowedits =false
if condition=true
field.locked=false
field.enalble=true
The same thing I have replicated in current event of the form.Basically I have just kept the code wherever the allowedits was set to fasle.
But my field is still locked and cannot edit it.Is this because once we set allowedits=false the fields in the page cannot be made editable again.
Is there any other alternative?
Appreciate the help.
Then you can't use a form-level setting.
If this is constant (the fields are always locked), simply set all other controls to Locked = True.
If it's dynamic, use a procedure like this:
Private Sub SetEditable(EnableEdit As Boolean)
Dim ctl As Control
For Each ctl In Me.Controls
' The main editable control types (add more if they occur on your form)
If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Or _
ctl.ControlType = acCheckBox Or ctl.ControlType = acSubform Then
If ctl.Name = "MySpecialDateField" Then
' Always editable
ctl.Locked = False
Else
ctl.Locked = Not EnableEdit
' If you want to provide a visual feedback:
' 0 = Flat (locked), 2 = Sunken (editable)
ctl.SpecialEffect = IIf(EnableEdit, 2, 0)
End If
End If
End If
Next ctl
End Sub
I have a Access 2010 Database using a multivalued field (the Access inbuilt way to have m:n-relation between two tables).
To keep track of changes to the database I use an AuditTrail VBA procedure every time the corresponding form is updated, saving all the changes to history table.
Now, when I change the value of the ComboBox and the loop reaches the ComboBox bound to the multivalued field, the procedure throws an error because of incompatible Data types:
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "History" Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
With rst
.AddNew
![timestamp] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![recordid] = Screen.ActiveForm.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![beforeValue] = ctl.OldValue
![afterValue] = ctl.Value
.Update
End With
End If
End If
Next ctl
How do I get the actual Value and the OldValue from a combobox converted to string in VBA?
I tried combobox.focus and then combobox.Text
This works, but doesnt help with the OldValue problem.
How to properly use the value and oldvalue property of comboboxes? The official VBA object reference for comboboxes doesn't help at all.
https://msdn.microsoft.com/en-us/library/office/ff821691.aspx
When ctl references a multi-valued combo box with at least one item selected, your test condition ...
Nz(ctl.Value) <> Nz(ctl.OldValue)
... will certainly throw a type mismatch error. In that situation, ctl.Value is actually a variant array, and Nz() can't cope with it. The problem is essentially the same as this ...
Debug.Print Nz(Array(1,2,3)) '<- type mismatch error
Perhaps you would prefer to grab a string of the concatenated combo selections ...
Debug.Print Join(ctl.Value, ",")
If that seems useful, beware that ctl.Value will be Null when none of its items is selected. And attempting to Join() Null will also trigger type mismatch error.
Note those issues also apply to ctl.OldValue.
But there may be yet another complication. Based on my testing I'm skeptical whether OldValue is reliable for a multi-valued combo box. If you also find that to be the case, use the form's current event to store the combo's initial selections in a form level variable and reference that variable (instead of OldValue) in your audit procedure.
It is not an elegant solution, only a quick & dirty workaround:
Modify your code so that it checks differently ComboBox1 and the other controls.
The .Value and .OldValue are basically an array of variants.
Dim afterValue as variant
Dim beforeValue as Variant
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "History" Then
If Ctl.name = "ComboBox1" then
err.clear
on error resume next
I=0
afterValue = ""
beforeValue = ""
while err=0
'
' Throws an error if 'out of range', i.e. after the last value
'
afterValue = afterValue + Nz(Cstr(ComboBox1.Value(I))) + ";"
beforeValue = beforeValue + Nz(Cstr(ComboBox1.OldValue(I))) + ";"
wend
else
afterValue = ctl.Value
beforeValue = Nz(ctl.OldValue)
endif
If Nz(ctl.Value) <> a$ Then
With rst
.AddNew
![timestamp] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![recordid] = Screen.ActiveForm.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![beforeValue] = beforeValue
![afterValue] = afterValue
.Update
End With
End If
End If
Next ctl
I would like to clear all the controls in an Access 2013 form. I found the following script on this site by Johan Godfried and it works very well.
Private Sub resetForm()
Dim ctl As Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.value = ""
Case "CheckBox", "ToggleButton"
ctl.value = False
Case "OptionGroup"
ctl = Null
Case "OptionButton"
' Do not reset an optionbutton if it is part of an OptionGroup
If TypeName(ctl.Parent) <> "OptionGroup" Then ctl.value = False
Case "ComboBox", "ListBox"
ctl.RowSource = vbNullString
End Select
Next ctl
End Sub
Except that when the iteration selects a calculated control I receive the following error:
You can't assign a value to this object.
Is there a property that can be used to by-pass calculated controls?
try Me.myControl.controlsource="" to unbound that control
and then call resetForm()
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