The following code is called everytime the form is opened. It works great until the 5th opening and then misses deleting one of the controls. Anyone know why this is?
For Each cb In Forms(frmName).Controls
If cb.ControlType = acCheckBox Then
If Left(cb.Name, 3) = "clr" Then
DeleteControl frmName, cb.Name
End If
ElseIf cb.ControlType = acLabel Then
If Left(cb.Name, 3) = "clr" Then
DeleteControl frmName, cb.Name
End If
End If
Next
When you delete an item from a collection in Access the next item moves into that items spot.
Thus when it comes to deleting items from a collection you must start at the end of the collection and go backward.
So replace the
For Each cb In Forms(frmName).Controls
line with
For counter = Forms(frmName).Controls.Count - 1 To 0 Step -1
set cb = Forms(frmName).Controls.Item(counter)
My next question though is what is your overall objective? It's unusual to be manipulating controls in design view programmatically.
Related
I have a list of questions each with 4 possible answers that are displayed as toggle buttons on my form. What I want to do is if the user chooses either of the first two buttons, the Option Value stored is "1", if they choose either of the last two buttons, the Option Value stored should be "0". The option values must be different for each toggle button in a control group. Is there a way to recode the toggle buttons to store the desired response? (I work in psychology, thus the bait and switch of offering 4 choices to the user when really only two responses are recorded).
Here is what I have tried:
I tried thinking about a recode as jcarroll suggested, but this is a circular reference:
Private Sub Q1_Click()
If Me.Q1 = 1 Or 2 Then
Me.Q1 = 1
Else:
Me.Q1 = 0
End If
End Sub
I could recode into another variable but that is just as clunky as using a SQL statement on the data post-hoc, for instance:
NewVariable=Iif([Q1]=1,1,iif([Q1]=2,1,0)
Finally, I tried to code have both toggle buttons have the same Option Value (which causes both to look pressed if either is pressed) and recode the unpressed toggle button's back color. But while my code looks correct to me, this did not change the pressed color of the toggle button (which I think has to do with over riding toggle button design settings):
Private Sub Frame5_Click()
If Toggle8.Value = True Then
Toggle9.BackColor = &HFF00&
Else
Toggle9.BackColor = &H8000000F
End If
End Sub
I could not come up with any programming solutions on the form itself to solve this. The alternative is that I wrote a procedure to apply to the data after it is collected which will be stored as 1,2,3,4 to convert it to 0 or 1. This procedure also sums up the 1's. I have 50 variables/questions that will be passed through this procedure (as well as another like it that converts 3&4 to 1).
Public Function Recode1(ParamArray arg()) As Variant
Dim Size As Integer, skips As Integer, i As Integer, result As Variant
'Recodes first two toggle buttons as "1" for AQ assessment
Size = UBound(arg) + 1
For i = 0 To Size - 1
If IsNull(arg(i)) Or Not (IsNumeric(arg(i))) Or arg(i) = -99 Then
skips = skips + 1
Else
If arg(i) = 1 Or arg(i) = 2 Then
result = result + 1
Else:
result = result + 0
End If
End If
End sub
I know there's similar posts as this one, but i have not managed to resolve my error by reading them, so i'm posting.
I m trying to make an input form in Ms Access, the user will input two barcodes, and then he ll press a button to commit those values to a table, the process will be repeated until he needs to store said table, in which case there's another button event for that. When they enter each set of records to the input boxes and hit commit, the record is saved, and all the fields are cleared, cursor is going to barcode1 field to await new entries.
The problem starts when, after one successful execution of everything, if i rerun the database, and restart everything, when i try to press the button to commit a new entry into the table, i get the following error:
Error 3167: Record is Deleted
If i close (x) the application and restart it, everything works normally again.
Here's the relevant code, with the point the debugger gives me the error:
Private Sub CommitButton_Click()
'If (Me!Barcode1 = "**************************") Or IsNull(Me!Barcode1) Or IsNull(Me!Barcode2) Then
'If (Len(Me!Barcode1) < 2) Or (Len(Me!Barcode2) < 2) Then
len_barcode1 = Len(Me!Barcode1)
len_barcode2 = Len(Me!Barcode2)
If (len_barcode1 < 1 Or IsNull(len_barcode1)) Or (len_barcode2 < 1 Or IsNull(len_barcode2)) Then
MsgBox ("IS NULL - NOT SAVING")
Else
MsgBox ("IS NOT NULL - SAVING")
fld2 = Barcode2.Value
fixed = Mid(fld2, 6, 14)
Barcode2.Value = fixed
'DoCmd.SetWarnings (WarningsOff)
DoCmd.RunCommand acCmdSaveRecord
DoCmd.GoToRecord acDataForm, "BarCodeDataForm", acNext, 1
Me.Barcode1.SetFocus
'DoCmd.SetWarnings (WarningsOn)
Me.Barcode1.Value = Null
Me.Barcode2.Value = Null
Me.ValuePrice.Value = Null
Me.Barcode1.SetFocus
End If
End Sub
As you see, there is a manual change to a value (Barcode2), the error appears on exactly the next line:
DoCmd.RunCommand acCmdSaveRecord
Is there a way to commit the changes or resolve this? Thank you
I am trying to find the row number in a sheet using the .Find function in a recursive function.
I set an object called Found = .Find.... and it works great... for a little bit. I set it when I'm 1 level of recursion deep, then set it again when I'm 2 levels deep. Then, my code finds the end of the path and starts backing up until it gets back to 1 level deep, but not my Found object has been re-declared and kept its values from the 2nd level. My other variables (ThisRow etc...) keep the value of the level that they are in, and that's what I would like to do with the object Found. Is there a way that I can declare Found locally so that it's value doesn't extend to the next function, and can't be overwritten in a deeper level? You can find my code below for reference.
Here is my current code - irrelevant parts cut out:
Public Function FindChildren()
ThisRow = AnswerRow 'Also declared before function call
BeenHereCell = Cells(ThisRow, "O").Address
If Range(BeenHereCell).Value = "Yes" Then
Exit Function 'That means we've already been there
End If
Range(BeenHereCell).Value = "Yes"
With Worksheets("MasterScore").Range("j1:j50000")
Set Found = .Find(NextQuestionID, LookIn:=xlValues)
If Not Found Is Nothing Then
firstAddress = Found.Address
NextCell = Found.Address
Do
AnswerRow = Range(NextCell).Row
FindChildren 'This is where it's recursive.
Set Found = .FindNext(Found)
NextCell = Found.Address
Loop While Not Found Is Nothing And Found.Address <> firstAddress
End If
End With
End Function
Now I have gotten around it by activating cells, but it makes my code a lot slower. Currently I am using this:
Set Found = Worksheets("MasterScore").Range("j1:j50000").Find(NextQuestionID, LookIn:=xlValues)
If Not Found Is Nothing Then
Count = 1
Do
Columns("J:J").Select
FirstFoundRow = Selection.Find(What:=NextQuestionID, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Row
For i = 1 To Count
Selection.FindNext(After:=ActiveCell).Activate
Next i
AnswerRow = ActiveCell.Row
If AnswerRow = FirstFoundRow And Count <> 1 Then Exit Do
FindChildren
Count = Count + 1
Loop
End If
This way, I don't have to set the value of the object again, but I have to iterate through it.FindNext quite a few times and each time it runs that line its also activating the row. I really just want something like.
AnswerRow = .Find(nth instance of NextQuestionID).Row
(I have about 50k rows and the count goes to about 20 pretty often so it really takes a while).
I'd appreciate any ideas! Currently my code is working, but it's going to take a good part of the day to complete, and I'll need to run this again at some point!
I ended up finding a way to speed it up a little bit. I think this could help someone so I will share what I've found.
It's not the best solution (I would have preferred to just declare the object locally so my other functions wouldn't change it's value), but at least with this I'm not looping through 20 or so finds every iteration of the Do Loop.
Set Found = Worksheets("MasterScore").Range("j1:j50000").Find(NextQuestionID, LookIn:=xlValues)
If Not Found Is Nothing Then
NextAnswerRange = "j" & 1 & ":" & "j50000" 'The first search will be from the beginning
Do
Set Found = Worksheets("MasterScore").Range(NextAnswerRange).Find(NextQuestionID, LookIn:=xlValues)
NextCell = Found.Address
AnswerRow = Range(NextCell).Row
NextAnswerRange = "j" & AnswerRow & ":" & "j50000"
If LastAnswerRange = NextAnswerRange Then Exit Function 'This would mean we've reached the end.
LastAnswerRange = NextAnswerRange
FindChildren
Loop
End If
End Function
So we know we've already covered our bases with previous ranges since it always finds the immediate next. We just change the range of the search each time and it will find the next value.
A weird thing about this solution is that if you are looking for a value among range 70 -> 50,000 and you have the answer your looking for on row 70, it will actually find the next row (it skips that first one). But, if there aren't any rows past 70 that have the answer, it will actually take the value from row 70. That meant that I couldn't do
NextAnswerRange = "j" & AnswerRow + 1 & ":" & "j50000"
because it would miss some values. Doing it without the + 1 meant at the end of the document I would end up searching the same last value over and over (it would never go back to Found Is Nothing) so I had to put in the check to see if the LastAnswerRange = NextAnswerRange.
I hope this helps someone. I don't think it's the most elegant solution, but it's a lot faster than what I had.
I am trying to problematically change the dropdown selection on an InternetExplorer.Application then save that selection. The code I have so far is
dim myValue
myValue="3"
for j = 0 to obj.Options.length - 1
if(obj.Options(j).Value = myValue) then
obj.Options(j).selected = true
exit for
end if
next
This works on the current pages dropdown list, however when I click save, the value "3" isn't saved and it reverts back to its original value when I reload the page.
Another thing to mention is that when I manually click the dropdown and select a value then save, it does update to the new value when I reload the page. I have tried the obj.click function on it but I do not believe a programmatic mouse click works like a actual mouse click with the action listener.
My guess would be something to do with the databinding between the new value selection and the action listener for the page. I am fairly new to vbscript and have tried all sorts of different things.
Any help would be very much appreciated. Thank You!
Supposing you have the obj object set properly, e.g. something like
set obj = ie.document.getElementById("my_dropdown") then you should ensure that only one option is selected:
for j = 0 to obj.Options.length - 1
if (obj.Options(j).Value = myValue) then
obj.Options(j).selected = true ''' do not exit for
else
obj.Options(j).selected = false
end if
next
or
For Each opt In obj.Options
If opt.Value = myValue Then
opt.Selected = True
Else
opt.Selected = False
End If
Next
Caution: above code snippet could result to (undesired?) case that no option remains selected!
I want to use VBA (or some other solution) to conditionally change the background color of a form based off what number users enter in a numeric field. Basically, after they enter their answer to the Starter question, if they entered 1 then I want the form background to change to a specific shade of blue, and if they entered 2 then I want the form background to change to a specific shade of green. I saw a code that looks like it would be very similar to my need in another question on here, but I couldn't figure out how to make the code work, and was having trouble figuring out exactly how/where to put each module.
Some information:
The field I want it to be based off of is numeric, called Starter, and through data validation users are limited to entering 1, 2, 9, or leaving it blank. I only want the color to change if it's entered as 1 or 2.
I'm using Access 2010
the form has neither header nor footer
the code I was attempting to use and made some alterations to is the following:
Private Sub Form_AfterUpdate()
blue_yes = "15325906"
green_no = "13888226"
Dim colorThis As String
booWhatever = Me.Starter ''Use of the variable can prevent problems
If booWhatever = 1 Then
colorThis = "blue_yes"
End If
If booWhatever = 2 Then
colorThis = "green_no"
End If
subFrm.Form.Section(acDetail).BackColor = colorThis
subFrm.Form.Repaint
End Sub
I've also managed, off a very different piece of code, to sort of do what I want, but the way it's working it seems to change the status of all forms, not just the one I'm currently working with, which is the goal. So for example if I enter 2 to starter, it changes the background color of every single record's form.
Private Sub Starter_AfterUpdate()
If Me.Starter = "1" Then Me.Detail.BackColor = vbBlue
If Me.Starter = "2" Then Me.Detail.BackColor = vbGreen
End Sub
EDIT:
Welp, embarrassingly I found the solution. It's not a very neat one, but it works.
Private Sub Form_Current()
Dim Presence As String
Presence = Nz(Me.Starter.Value, 9)
Select Case Presence
Case "1"
Me.Detail.BackColor = 15325906
Case "2"
Me.Detail.BackColor = 13888226
Case Else
Me.Detail.BackColor = vbWhite
End Select
End Sub
Private Sub Starter_AfterUpdate()
Dim Presence As String
Presence = Nz(Me.Starter.Value, 9)
Select Case Presence
Case "1"
Me.Detail.BackColor = 15325906
Case "2"
Me.Detail.BackColor = 13888226
Case Else
Me.Detail.BackColor = vbWhite
End Select
End Sub
I know it is a really old question (probably you have already solved it in a better way) but I will give it a try anyways.
Try the following:
Private Sub Text0_Change()
Select Case Me.Text0.Text
Case ""
Case "1"
Me.Detail.BackColor = 15325906
Case "2"
Me.Detail.BackColor = 13888226
Case Else
Me.Detail.BackColor = vbWhite
End Select
End Sub
EDIT:
I tried that and it works I think now as it supposed to do.
When you change the text on the text box triggers this event every time, runs the Sub, checks it's own text and changes the color of the form as described.
The change is that I changed the property of the field it checks. From Value to Text. We want when the event triggers to check the current text because the Value property updates when you "finish" with the textbox (after you press enter or the focus on the control is lost) and we want the change to happen the same moment we press the key changing the value and not later.
The second change and the reason we got strange patterns before is that I have added one more Case when the text is "" to do nothing on that change (empty case). Without that case when we used delete or backspace to remove the text and left the textbox empty ("") then the case else was True and it changed the background color.
I hope this is the correct answer now. Please let me know!