Solved loop all controls (1 Viewer)

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
It is strange. When I do new form with the same as you it works.
Normalny when you press label0 etc the DoCmd.GoToRecord , , acGoTo, 25 id fired.
It is strange it work and now not:unsure:
 

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
Well the line was commented.
Normally when I press label it directes me to the record.
DoCmd.GoToRecord , , acGoTo, 1.

Is there any relation to this?
 

cheekybuddha

AWF VIP
Local time
Today, 18:39
Joined
Jul 21, 2014
Messages
1,012
Yes, your event handler Label1_Click() is no longer wired in.

We can add the code to the onclick function:
Code:
Private Function LblClickGoToRecord(idx As Integer) As Boolean

  DoCmd.GoToRecord , , acGoTo, idx
  LblClickGoToRecord = (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
      Call LblClickGoToRecord(idx)
    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

hth,

d
 

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
I cannot understand why I go this same error

lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")" . The statement has got invalid syntax
 

cheekybuddha

AWF VIP
Local time
Today, 18:39
Joined
Jul 21, 2014
Messages
1,012
The line looks fine to me.

Maybe post the whole of your Form_Load() code in case it's something else in there.
 

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
Ok.
Code:
Option Compare Database
Option Explicit




Private Const LABEL_PREFIX As String = "Etykieta"


Public Function wstaw()


'funkcja sprawdza na wejściu czy jest "paid" wypłęnione. jeśli nie zwraca komnikat i zmienia kolor
 
 
 If Len(Me.paid.Value & vbNullString) = 0 Then
       Me.paid.BackColor = RGB(255, 255, 0)
       MsgBox "Miejsce nie opłacone"
    Else
     Me.paid.BackColor = RGB(255, 255, 255)
    
End If
End Function

Private Sub bntFilter_Click()
DoCmd.OpenForm "Filtruj", WindowMode:=acDialog
End Sub

Private Sub btnDelete_Click()
  Me.MAPA = Null 'ImagePath
    ' hide image control and show 'No Image' label
    Me.lblNoImage.Visible = True
    Me.ctrlImage.Visible = False
End Sub

Private Sub btnPrint_Click()

'On Error GoTo ErrorHandler
  
                  
                 DoCmd.OpenForm "Drukuj", acNormal
          
End Sub



Private Sub btnRight_Click()

    DoCmd.GoToRecord , , acNext
    

End Sub

Private Sub btnService_Click()
DoCmd.OpenForm "OknoKomunikatu", WindowMode:=acDialog

End Sub



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 ctlr As Control
 
 'zmienia kolor 0 w formularz Drukuj  - referes to another form and changes the colour
 For Each ctlr In Forms!Drukuj.Controls
 
 If TypeOf ctlr Is Label Then
  ctlr.BackStyle = 0
 
  End If
 
 Next ctlr
End Function

Private Function LblClickGoToRecord(idx As Integer) As Boolean

  DoCmd.GoToRecord , , acGoTo, idx  
 
  LblClickGoToRecord = (Err = 0)

End Function

Public Function wybor()



End Function
Private Sub Etykieta25_Click()
'DoCmd.GoToRecord , , acGoTo, 25
End Sub


Private Sub Etykieta24_Click()
'DoCmd.GoToRecord , , acGoTo, 24
End Sub

Private Sub Form_Current()


Dim con As Variant
 
 
    
    If Not IsNull(Me.MAPA) Then 'było ImagePath
        ' show image control and hide 'No Image' label
    
        Me.lblNoImage.Visible = False
        Me.ctrlImage.Visible = True
    Else
        ' hide image control and show 'No Image' label
        Me.lblNoImage.Visible = True
        Me.ctrlImage.Visible = False
    End If
 
 'hiding all colours
 
 Call wstaw
  
End Sub

Private Sub Form_Load()
DoCmd.Maximize


 
 
  Dim lbl As Access.Control



  For Each lbl In Me.Controls
    
      '  If ButtonOneClick Then
      If lbl.ControlType = acLabel Then ' And LEFT(lbl.Name, Len(LABEL_PREFIX)) = LABEL_PREFIX Then
   ' Me.Controls("Etykieta" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1)).Value
    lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")"
  End If
  'End If
 
    
  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("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
      Call LblClickGoToRecord(idx)
  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


Private Sub Etykieta1_Click()
'DoCmd.GoToRecord , , acGoTo, 1
 'Me.Etykieta1.BackStyle = 1
    ' Me.Etykieta1.BackColor = RGB(255, 255, 2) 'żółty
    

'Forms!Drukuj.Controls("Etykieta1").BackStyle = 1
'Forms!Drukuj.Controls("Etykieta" & i).BackColor = RGB(255, 255, 0)


End Sub

Private Sub Etykieta2_Click()
    ' DoCmd.GoToRecord , , acGoTo, 2
    
     'Me.Etykieta2.BackStyle = 1
     'Me.Etykieta2.BackColor = RGB(255, 255, 2) 'żółty
    
'DoCmd.OpenForm "Drukuj", acDesign, , , , acHidden

'Forms!Drukuj.Controls("Etykieta" & i).BackStyle = 1
'Forms!Drukuj.Controls("Etykieta2").BackStyle = 1
'Forms!Drukuj.Controls("Etykieta" & i).BackColor = RGB(255, 255, 0)


'Forms!Drukuj.l2.BackColor = RGB(255, 255, 2)

End Sub

Private Sub Etykieta3_Click()
'DoCmd.GoToRecord , , acGoTo, 3

 'Me.Etykieta3.BackStyle = 1
    ' Me.Etykieta3.BackColor = RGB(255, 255, 2) 'żółty
    
     'Forms!Drukuj.Controls("Etykieta" & i).BackStyle = 1
'Forms!Drukuj.Controls("Etykieta3").BackStyle = 1
'Forms!Drukuj.Controls("Etykieta" & i).BackColor = RGB(255, 255, 0)

End Sub

Private Sub Etykieta4_Click()
'DoCmd.GoToRecord , , acGoTo, 4
   '  Me.Etykieta4.BackStyle = 1
    ' Me.Etykieta4.BackColor = RGB(255, 255, 2) 'żółty

End Sub

Private Sub Etykieta5_Click()
'DoCmd.GoToRecord , , acGoTo, 5
    ' Me.Etykieta5.BackStyle = 1
    ' Me.Etykieta5.BackColor = RGB(255, 255, 2) 'żółty

End Sub

Private Sub Etykieta23_Click()
'DoCmd.GoToRecord , , acGoTo, 23
End Sub

Private Sub Polecenie1218_Click()
     
    Dim strPath As String
    
    ' open 'file open' dialogue and get path to selected file
    strPath = GetFilePath()
    
    If Len(strPath) > 0 Then
        Me.MAPA = strPath 'ImagePath
        Me.ctrlImage.Visible = True
        Me.lblNoImage.Visible = False
    End If
    
Exit_here:
    Exit Sub
    
Err_Handler:
    MsgBox Err.Description, vbExclamation, "Error"
    Resume Exit_here
    End Sub
    
Private Sub Polecenie1222_Click()

    Me.MAPA = Null 'ImagePath
    ' hide image control and show 'No Image' label
    Me.lblNoImage.Visible = True
    Me.ctrlImage.Visible = False
End Sub

Private Sub Polecenie1725_Click()
DoCmd.OpenForm "Filtruj", WindowMode:=acDialog
End Sub

Private Sub SaveClip2Bit_Click()
DoCmd.OpenForm "Drukuj", WindowMode:=acDialog
End Sub

Private Sub Detail_Click()
  Call SetLabelColour

End Sub
 

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
I think I have figure it out.
I have copied all the controls, tables, hole project and distroyed the labels connection via macro. Now I enumarete the labels like lab0, lab2 according to the table records. And now it is working. However I still get the error like above
Code:
lbl.OnClick = "=LabelClick(" & Mid(lbl.Name, Len(LABEL_PREFIX) + 1) & ")" . The statement has got invalid syntax
 

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
You can find there lots of labels. By reason I had to add such qty :)
 

Attachments

  • LCT_v1_26.02.2020_NEW.zip
    714.5 KB · Views: 64

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
I think just this MID function. THe most importnat is "sektor" and "tom" table. the rest I do not think they couse a prolem
 

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
it is strange. When I copy and paste the new labels to the form without macros related to labels the code is working, giving just the error like above.
 

cheekybuddha

AWF VIP
Local time
Today, 18:39
Joined
Jul 21, 2014
Messages
1,012
Ok, They are doing something with my machine at work and so I don't have a copy of Access to open your db (Grrr!). I only have Access 2007 on another machine and it can't open your db (I guess it's made with a newer version).

Do you know how to step through code?
 

cheekybuddha

AWF VIP
Local time
Today, 18:39
Joined
Jul 21, 2014
Messages
1,012
OK, maybe try it like this to try and see what happens:
Code:
Private Sub Form_Load()
 
  Dim lbl As Access.Control, strIdx As String

  DoCmd.Maximize
  Debug.Print "Form loading:", Format(Now, "yyyy\-mm\-dd hh:nn:ss")
  For Each lbl In Me.Controls
    If lbl.ControlType = acLabel Then ' And LEFT(lbl.Name, Len(LABEL_PREFIX)) = LABEL_PREFIX Then
      Debug.Print "Label name:", lbl.Name
      strIdx = Mid(lbl.Name, Len(LABEL_PREFIX) + 1)
      Debug.Print "Label index:", strIdx
      Debug.Print "Original OnClick:", lbl.OnClick
      lbl.OnClick = "=LabelClick(" & strIdx & ")"
      Debug.Print "New OnClick:", lbl.OnClick
    End If
  Next
  Debug.Print

End Sub

Then open your form and post here what is output in the Immediate Window (Ctrl+G)

hth,

d
 

romanlo

Member
Local time
Today, 19:39
Joined
Feb 24, 2020
Messages
38
It shows me:
New OnClick: =LabelClick(1250)
Label name: Etykieta239
Label index: 239
Original OnClick:
New OnClick: =LabelClick(239)
Label name: Etykieta_150
Label index: _150
Original OnClick:
 

Users who are viewing this thread

Top Bottom