Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target = "" Then Exit Sub
If Not Intersect(Target, [G2]) Is Nothing Then
If Target = "FIXES" Then Flag = False Else Flag = True
Application.EnableEvents = False
ActiveSheet.Shapes("GroupeFixes").Visible = Flag
ActiveSheet.Shapes("GroupeAmbulants").Visible = Not (Flag)
If Target = "AMBULANTS" Then Target = "FIXES" Else Target = "AMBULANTS"
If Target = "AMBULANTS" Then [Q2] = "Amb" Else [Q2] = "Fixe"
[A1].Select
Application.EnableEvents = True
End If
Exit Sub
Quel est le but de la manip ?
Appliquer les couleurs de Paramètres sur les shapes de la feuille Caisse ?
Mais dans ce cas pourquoi ne pas le faire quand on modifie la feuille Paramètres, une fois pour toute.
On n'a pas à changer les couleurs de la feuille Caisse lorsqu'on est sur celle ci, mais uniquement lorsqu'on change les couleurs de la feuille Parametres.
Couleur = Target.Interior.Color
' For n = 1 To Dr1: ActiveSheet.Shapes("Rectangle " & n).Fill.ForeColor.RGB = Couleur: Next n
For n = 1 To Dr2
Couleur = Par.Range("AA" & n).Interior.Color
'*****************
If Par.Range("AA" & n) = ActiveSheet.Shapes("Rectangle " & n + Dr1).TextRange.Text Then
'*****************
ActiveSheet.Shapes("Rectangle " & n + Dr1).Fill.ForeColor.RGB = Par.Range("AA" & n).Couleur
End If
Next n
Range("H8") = ActiveSheet.Shapes("Rectangle").TextRange.Text
Range("H8") = ActiveSheet.Shapes("Rectangle").TextFrame2.TextRange.Text
Quel est le but de la manip ?
Appliquer les couleurs de Paramètres sur les shapes de la feuille Caisse ?
Mais dans ce cas pourquoi ne pas le faire quand on modifie la feuille Paramètres, une fois pour toute.
On n'a pas à changer les couleurs de la feuille Caisse lorsqu'on est sur celle ci, mais uniquement lorsqu'on change les couleurs de la feuille Parametres.
If Par.[AB1] = "" Then
For n = 1 To Dr2
n1 = Dr1 + n
' Couleur = Par.Range("AA" & n).Interior.ColorIndex '.Interior.Color '.RGB
Ftx = Right(Par.Range("AA" & n + 1), 2)
If Ftx = Right(ActiveSheet.Shapes("Rectangle " & n1).TextFrame.Characters.Text, 2) Then 'TextFrame.Characters.Text
If Ftx = "de" Then ActiveSheet.Shapes("Rectangle " & n1).Fill.ForeColor.RGB = RGB(255, 192, 0)
If Ftx = "er" Then ActiveSheet.Shapes("Rectangle " & n1).Fill.ForeColor.RGB = RGB(217, 217, 217)
If Ftx = "K2" Then ActiveSheet.Shapes("Rectangle " & n1).Fill.ForeColor.RGB = RGB(191, 191, 191)
If Ftx = "xe" Then ActiveSheet.Shapes("Rectangle " & n1).Fill.ForeColor.RGB = RGB(216, 228, 188)
If Ftx = "ue" Then ActiveSheet.Shapes("Rectangle " & n1).Fill.ForeColor.RGB = RGB(218, 238, 243)
If Ftx = "es" Then ActiveSheet.Shapes("Rectangle " & n1).Fill.ForeColor.RGB = RGB(197, 217, 241)
If Ftx = "ZH" Then ActiveSheet.Shapes("Rectangle " & n1).Fill.ForeColor.RGB = RGB(141, 180, 226)
Par.[AB1] = "MAJ"
End If
Next n
End If
Sub CouleurTextesFonds()
'grâce à l'aide de SYLVANU
'Procédure pour mise en couleur des rectangles Fixes
'Mettre à jour le texte des Rectangles FIXES avec Par.[V2 à 45 maxi]
Set Par = Sheets("Paramètres")
Sheets("Caisse").Select
If Par.[AB1] = "Couleur" And [G2] = "FIXES" Then
For n = 2 To Par.[V45].End(xlUp).Row
'met le texte
ActiveSheet.Shapes("Rectangle " & n - 1).TextFrame2.TextRange.Text = Par.Range("V" & n).Value
'met la bonne couleur dans le Rectangle
ActiveSheet.Shapes("Rectangle " & n - 1).Fill.ForeColor.RGB = Par.Range("V" & n).Interior.Color
'met la couleur de police
If Par.Range("V" & n).Font.Color = RGB(0, 0, 0) Then ActiveSheet.Shapes("Rectangle " & n - 1).Fill.BackColor.RGB = RGB(0, 0, 0)
If Par.Range("V" & n).Font.Color = RGB(255, 255, 255) Then ActiveSheet.Shapes("Rectangle " & n - 1).Fill.BackColor.RGB = RGB(255, 255, 255)
Next n
Par.[AB1] = "MAJ Couleurs"
End If
End Sub