Solved loop all controls (1 Viewer)

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
Hi I am trying to resolve the problem of my work.
I have program that is searching through the database. I have a lot of controls labels. I want to change the specific label color by looping.
This works for all controls to disable the color. It is OK. on current form action
Code:
Public Function ZmienKolor()
 Dim con As Control
 
 For Each con In Me.Controls
 
 If TypeOf con Is Label Then
  con.BackStyle = 0
 
 
 
 
   End If
  
 
 
 Next con
 
 '*****************************
  'odwołanie do formualrza Drukuj i jego zestwau kontrolek
 'aby odwołać się do ctl muszę niejawnie otworzyć formualarz
 DoCmd.OpenForm "Drukuj", acDesign, , , , acHidden
 
 Dim ctl As Control
 
 'zmienia kolor 0 w formularz Drukuj
 For Each ctl In Forms!Drukuj.Controls
 
 If TypeOf ctl Is Label Then
  ctl.BackStyle = 0
 
  End If
 
 Next ctl
End Function

Now I want to use loop to do oncllick action when I press "label1" the right record is set. And the "BackStyle =1" and the "BackColor" is set to the desired one.
 

Guus2005

AWF VIP
Local time
Tomorrow, 00:36
Joined
Jun 26, 2007
Messages
2,621
Firstly, you don't have to open a form in design mode to loop through the controls.
Secondly, the rest of your question i don't understand.
Now I want to use loop to do oncllick action when I press "label1" the right record is set. And the "BackStyle =1" and the "BackColor" is set to the desired one.
Can you elaborate?
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
Sorry for mess.
This is single form.
About elaboration.
I have let's say 100 labels.
I can do backstyle and backcolor for all just with one loop.
The labels work like a button when I press I want ut to use "zmienKolor" Function and change the clicked label to yellow.
I have the labels called lab1,lab2 etc...
How to loop each label to achive just the one lab colored
 

cheekybuddha

AWF VIP
Local time
Today, 23:36
Joined
Jul 21, 2014
Messages
1,012
Hi

I would do it this way:
Code:
Private Sub Form_Load()

  Dim lbl As Label

  For Each lbl In Me
    lbl.onClick = "=LabelClick(" & Mid(lbl.Name, 4) & ")"
  Next

End Sub

Private Function LabelClick(idx As Integer) As Boolean

  Call SetLabelColour
  Call SetLabelColour(idx, vbYellow)
  LabelClick = (Err = 0)

End Function

Private Function SetLabelColour(Optional idx As Integer = -1, Optional lColour As Long = -1) As Boolean

  Dim lbl As Label

  If idx >= 0 Then
    If lColour >= 0 Then
      If Not Me("lbl" & idx).BackColor = lColour Then Me("lbl" & idx).BackColor = lColour
      If Not Me("lbl" & idx).BackStyle = 1 Then Me("lbl" & idx).BackStyle = 1
    Else
      If Not Me("lbl" & idx).BackStyle = 0 Then Me("lbl" & idx).BackStyle = 0
    End If
  Else
    For Each lbl In Me
      If lColour >= 0 Then
        If Not lbl.BackColor = lColour Then lbl.BackColor = lColour
        If Not lbl.BackStyle = 1 Then lbl.BackStyle = 1
      Else
        If Not lbl.BackStyle = 0 Then lbl.BackStyle = 0
      End If
    Next
  End If
  SetLabelColour = (Err = 0)

End Function
(Untested)

hth,

d
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
Thanks for the reply. I have tried your code but I got some run-time error: 13. Maybe I am too "green" to resolve it.
the function "LabelClick" I am calling from the curent form. What coudl be wrong?
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 17:36
Joined
Feb 28, 2001
Messages
22,820
If you get an error, it SHOULD offer you a popup dialog box with chance to debug the code. Not that you would want to actually debug it by altering anything, but if you click the DEBUG option it will show you the code editing page and will highlight the line that is at fault with a yellow background. That will tell you which line is at fault. And that means you can tell US what line is at fault. So if you go far enough as to do that, you can do a copy/paste of several lines around the offending area so we can see it and maybe diagnose it by sight.
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
the problem appears
Code:
 For Each lbl In Me
in SetLabelColour function and also in
Code:
For Each lbl In Me
    lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, 4) & ")"
  Next
first line in Form_load
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
I thought lbl is not set to the existing labels so I have used:
Code:
Dim lbl As Label
 
lbl = Me.Controls("Etykieta" & idx)
but after that I got the run-time error:2465,
it says the labels which lbl referst to do not match "Etykieta-1". But in real Etykieta1 exists since "Etykieta-1" not
I have replaced lbl in me.part with Etykieta as its name.
Code:
 If idx >= 0 Then
    If lColour >= 0 Then
      If Not Me("Etykieta" & idx).BackColor = lColour Then Me("Etykieta" & idx).BackColor = lColour
      If Not Me("Etykieta" & idx).BackStyle = 1 Then Me("Etykieta" & idx).BackStyle = 1
    Else
      If Not Me("Etykieta" & idx).BackStyle = 0 Then Me("Etykieta" & idx).BackStyle = 0
    End If
  Else
    For Each lbl In Me
 

cheekybuddha

AWF VIP
Local time
Today, 23:36
Joined
Jul 21, 2014
Messages
1,012
I'm attaching an example to show what I mean.

You don't need to put anything in the click event handlers of the labels - it is done on Form_Load

I adjusted the code to take a constant for the label prefix (see the top of the module for Form1) - so in your db you can change it in just one place

hth,

d
 

Attachments

  • romanlo.zip
    18.2 KB · Views: 420

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 17:36
Joined
Feb 28, 2001
Messages
22,820
Code:
For Each lbl In Me

First problem: Me is not a collection of anything. It is a reference to the current class object when dealing with forms or reports. You probably wanted Me.Controls - which IS a collection of controls. Run-time error 13 is a 'Type Mismatch' which makes sense because Me isn't something that is eligible to be used in a For loop (at least not eligible when unqualified.)

Second problem: Your variable lbl is Dim'd as a label. The problem is that there are no labels in the Me.Controls collection. There are only controls, some of which might happen to be of type label.

Code:
Dim ctl as Access.Control

...

For each ctl in Me.Controls
   If ctl.Type =  acLabel then 
        ....       'do something
   End If
Next ctl
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
I'm attaching an example to show what I mean.

You don't need to put anything in the click event handlers of the labels - it is done on Form_Load

I adjusted the code to take a constant for the label prefix (see the top of the module for Form1) - so in your db you can change it in just one place

hth,

d
Dear cheekybudha.
I have checked your code it is working. when I try to djust to my project I got the erro like above:
with me. problem I suppose it shoould be Me.cotrols.

ALso i this part I got the problem
Code:
For Each lbl In Me
      If lColour >= 0 Then
        If Not lbl.BackColor = lColour Then lbl.BackColor = lColour
        If Not lbl.BackStyle = 1 Then lbl.BackStyle = 1
      Else
        If Not lbl.BackStyle = 0 Then lbl.BackStyle = 0
      End If
    Next
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
I have change the private constant to the label that exists.
However in else part I got the error that object doesn`t support this method
Code:
 For Each lbl In Me
      If lColour >= 0 Then
        If Not lbl.BackColor = lColour Then lbl.BackColor = lColour
        If Not lbl.BackStyle = 1 Then lbl.BackStyle = 1
      Else
        If Not lbl.BackStyle = 0 Then lbl.BackStyle = 0
      End If
    Next
  End If
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
OK. Works with some modification.
Code:
Private Sub Form_Load()
DoCmd.Maximize


 
 
  Dim lbl As Access.Control


  For Each lbl In Me.Controls
    lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"
  Next
 


End Sub
Private Function LabelClick(idx As Integer) As Boolean

  Call SetLabelColour
  Call SetLabelColour(idx, vbYellow)
  LabelClick = (Err = 0)

End Function

Private Function SetLabelColour(Optional idx As Integer = -1, Optional lColour As Long = -1) As Boolean

 
  Dim lbl As Access.Control
If idx >= 0 Then
    If lColour >= 0 Then
      If Not Me(LABEL_PREFIX & idx).BackColor = lColour Then Me(LABEL_PREFIX & idx).BackColor = lColour
      If Not Me(LABEL_PREFIX & idx).BackStyle = 1 Then Me(LABEL_PREFIX & idx).BackStyle = 1
    Else
      If Not Me(LABEL_PREFIX & idx).BackStyle = 0 Then Me(LABEL_PREFIX & idx).BackStyle = 0
    End If
  Else
 
    For Each lbl In Me.Controls
    If lbl.ControlType = acLabel Then
      If lColour >= 0 Then
        If Not lbl.BackColor = lColour Then lbl.BackColor = lColour
       If Not lbl.BackStyle = 1 Then lbl.BackStyle = 1
      Else
        If Not lbl.BackStyle = 0 Then lbl.BackStyle = 0
      End If
      End If
      
      
    Next
  End If
  SetLabelColour = (Err = 0)

End Function

Thanks Guys. I was very helpful. Learning with U is a pleasure.
 

cheekybuddha

AWF VIP
Local time
Today, 23:36
Joined
Jul 21, 2014
Messages
1,012
First problem: Me is not a collection of anything. It is a reference to the current class object when dealing with forms or reports. You probably wanted Me.Controls - which IS a collection of controls. Run-time error 13 is a 'Type Mismatch' which makes sense because Me isn't something that is eligible to be used in a For loop (at least not eligible when unqualified.)

Second problem: Your variable lbl is Dim'd as a label. The problem is that there are no labels in the Me.Controls collection. There are only controls, some of which might happen to be of type label.

Did you try my example in Post#11 ?

>> First problem: Me is not a collection of anything. It is a reference to the current class object when dealing with forms or reports <<
Absolutely! In this case Me is a form. The form's default property is its Controls collection, so just as you can write:
Me.Controls("txtSomeTextBox")
you can also write:
Me("txtSomeTextBox")
Similarly, just as you can write:
For Each ctl In Me.Controls
you can also write:
For Each ctl In Me

>> Second problem: Your variable lbl is Dim'd as a label <<
Yup! Spot on! For some reason I thought that For Each could pick the class of object when iterating a collection - probably because it had worked as in the example posted where there was only one class of object within the collection. :oops:

Romanlo seems to have figured out the modifications required. 👍

I would modify the Form_Load() sub slightly as well:
Code:
Private Sub Form_Load()

  Dim lbl As Control

  For Each lbl In Me
    If lbl.ControlType = acLabel And Left(lbl.Name, Len(LABEL_PREFIX)) = LABEL_PREFIX Then
      lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"
    End If
  Next
  
End Sub

And also add the prefix test to the SetLabelColour() Function:
Code:
Private Function SetLabelColour(Optional idx As Integer = -1, Optional lColour As Long = -1) As Boolean

  Dim lbl As Control

  If idx >= 0 Then
    If lColour >= 0 Then
      If Not Me(LABEL_PREFIX & idx).BackColor = lColour Then Me(LABEL_PREFIX & idx).BackColor = lColour
      If Not Me(LABEL_PREFIX & idx).BackStyle = 1 Then Me(LABEL_PREFIX & idx).BackStyle = 1
    Else
      If Not Me(LABEL_PREFIX & idx).BackStyle = 0 Then Me(LABEL_PREFIX & idx).BackStyle = 0
    End If
  Else
    For Each lbl In Me
      If lbl.ControlType = acLabel And Left(lbl.Name, Len(LABEL_PREFIX)) = LABEL_PREFIX Then
        If lColour >= 0 Then
          If Not lbl.BackColor = lColour Then lbl.BackColor = lColour
          If Not lbl.BackStyle = 1 Then lbl.BackStyle = 1
        Else
          If Not lbl.BackStyle = 0 Then lbl.BackStyle = 0
        End If
      End If
    Next
  End If
  SetLabelColour = (Err = 0)

End Function

hth,

d
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
Yeah i could work as well. Suprisingly when I have saved and reopened the problem has accured
Code:
lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"
Problem with not propriate method
 

cheekybuddha

AWF VIP
Local time
Today, 23:36
Joined
Jul 21, 2014
Messages
1,012
Hi,

Can you explain the problem in more detail - I'm not really following.
 

romanlo

Member
Local time
Tomorrow, 00:36
Joined
Feb 24, 2020
Messages
38
Ok I will try to explain. Before saving the project it worked exactly I wanted to. When I have saved the project and repopened it it gave me an erro
lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")" . The statement has got invalid syntax
Code:
Private Sub Form_Load()
DoCmd.Maximize


  lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"
 
  Dim lbl As Access.Control


  For Each lbl In Me.Controls

   If lbl.ControlType = acLabel Then And LEFT(lbl.Name, Len(LABEL_PREFIX)) = LABEL_PREFIX Then
    lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"
   End If
    
  Next
 


End Sub
 

cheekybuddha

AWF VIP
Local time
Today, 23:36
Joined
Jul 21, 2014
Messages
1,012
Code:
Private Sub Form_Load()
DoCmd.Maximize


  lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"     '  <-- *** Why have you got this line ?? ***

  Dim lbl As Access.Control


  For Each lbl In Me.Controls

   If lbl.ControlType = acLabel Then And LEFT(lbl.Name, Len(LABEL_PREFIX)) = LABEL_PREFIX Then
    lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"
   End If
   
  Next



End Sub
Try removing the line before declaration of lbl
 

Users who are viewing this thread

Top Bottom