XL 2021 Problème Variable

Mate59 · 29 Novembre 2023

Bonjour à tous,

Je viens vers vous après une journée de recherche sans trouver de solutions.

En effet, j'ai déclaré une variable dans mon document mais elle ne fonctionne pas.
J'ai essayé de redémarrer excel et le pc dans un second temps mais ça ne fonctionne pas. Je vous mets le fichier afin que vous puissiez m'aider et au cas où j'ai fais une erreur.

Merci beaucoup de votre aide!

Phil69970 · 29 Novembre 2023

Bonjour @Mate59

Je te propose ceci qui fonctionne

VB:

Option Explicit

Private Sub worksheet_activate()
Dim i As Long

'Si la date est égale à celle du jour alors l'objet (Shapes) passe au NOIR et retrouve sa couleur initial si autre date
For i = 2 To 330
    If Sheets("Feuil2").Cells(i, 1) = Date Then
        ActiveSheet.Shapes("bouton").Fill.ForeColor.RGB = vbBlack

        Exit Sub  'Si condition ok on quitte la sub

    Else
        ActiveSheet.Shapes("bouton").Fill.ForeColor.RGB = RGB(255, 192, 0)
    End If
Next i
End Sub

Voici l'explication sans "exit sub" tu continues la boucle et la condition else ==> couleur jaune se fait !!!!!

Merci de ton retour

Phil69970 · 29 Novembre 2023

Bonjour @Mate59

Je te propose ceci qui fonctionne

VB:

Option Explicit

Private Sub worksheet_activate()
Dim i As Long

'Si la date est égale à celle du jour alors l'objet (Shapes) passe au NOIR et retrouve sa couleur initial si autre date
For i = 2 To 330
    If Sheets("Feuil2").Cells(i, 1) = Date Then
        ActiveSheet.Shapes("bouton").Fill.ForeColor.RGB = vbBlack

        Exit Sub  'Si condition ok on quitte la sub

    Else
        ActiveSheet.Shapes("bouton").Fill.ForeColor.RGB = RGB(255, 192, 0)
    End If
Next i
End Sub

Voici l'explication sans "exit sub" tu continues la boucle et la condition else ==> couleur jaune se fait !!!!!

Merci de ton retour

Dranreb · 29 Novembre 2023

Bonjour.
Exit Sub peut être, après qu'il l'ait mis noir ?
Mais on peut le faire sans boucle avec :

VB:

Private Sub Worksheet_Activate()
If [COUNTIF(Feuil2!A2:A330,TODAY())] Then
   Me.Shapes("bouton").Fill.ForeColor.RGB = 0
Else
   Me.Shapes("bouton").Fill.ForeColor.RGB = RGB(255, 192, 0)
   End If
End Sub

Mate59 · 29 Novembre 2023

Merci cela fonctionne!

Mate59 · 29 Novembre 2023

Si je met un autre objet avec les même codes mais une colonne cible différente à la suite dans les codes cela ne fonctionne pas pour le coup car le exit sub met fin à la procédure.

VB:

Option Explicit

Private Sub worksheet_activate()
Dim i As Long

'Si la date est égale à celle du jour alors l'objet (Shapes) passe au NOIR et retrouve sa couleur initial si autre date

For i = 2 To 330

If Sheets("Feuil2").Cells(i, 1) = Date Then
ActiveSheet.Shapes("bouton").Fill.ForeColor.RGB = vbBlack
Exit Sub
Else
ActiveSheet.Shapes("bouton").Fill.ForeColor.RGB = RGB(255, 192, 0)
End If

If Sheets("Feuil2").Cells(i, 3) = Date Then
ActiveSheet.Shapes("bouton1").Fill.ForeColor.RGB = vbBlack
Exit Sub
Else
ActiveSheet.Shapes("bouton1").Fill.ForeColor.RGB = RGB(255, 192, 0)
End If

Next i

End Sub

Phil69970 · 29 Novembre 2023

@Mate59

Je te propose ce fichier

Remarque :
Feuilletonner ta demande n'est jamais bien perçu sur le forum car souvent il faut reprendre tout ou parti du code.
Donne directement tout ce que tu veux faire

Dranreb · 29 Novembre 2023

Avec ma dernière proposition c'est :

VB:

Private Sub Worksheet_Activate()
If [COUNTIF(Feuil2!A2:A330,TODAY())] Then
   Me.Shapes("bouton").Fill.ForeColor.RGB = 0
Else
   Me.Shapes("bouton").Fill.ForeColor.RGB = RGB(255, 192, 0)
   End If
If [COUNTIF(Feuil2!C2:C330,TODAY())] Then
   Me.Shapes("bouton2").Fill.ForeColor.RGB = 0
Else
   Me.Shapes("bouton2").Fill.ForeColor.RGB = RGB(255, 192, 0)
   End If
End Sub

Mate59 · 29 Novembre 2023

Merci pour votre aide!
Tout fonctionne parfaitement

XL 2021 Problème Variable

Mate59

XLDnaute Junior

Pièces jointes

Phil69970

Phil69970

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Mate59

XLDnaute Junior

Mate59

XLDnaute Junior

Pièces jointes

Phil69970

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

Mate59

XLDnaute Junior

Discussions similaires