Microsoft 365 Switcher entre 3 couleurs et 3 textes

pat66 · Hier à 09:37

Bonjour le forum,,

J'ai besoin de vos lumières car actuellement j'utilise cette macro qui fonctionne très bien, mais je souhaite avoir la possibilité de switcher avec 3 valeurs au lieu de 2
soit au lieu de switcher entre LMNP et LLI, pouvoir le faire entre LMNP, LLI et LLI vide et bien sur avoir 3 couleurs différentes, j'ai pensé à select case, mais je ne sais le rédiger, en tout cas merci pour aide.

Sub LLI()
With ActiveSheet.DrawingObjects("Rectangle : coins arrondis 1")
.Characters.Text = Array("LMNP", " LLI")(Abs(.Characters.Text = "LMNP"))
.Interior.Color = Array(RGB(0, 158, 71), RGB(217, 217, 217))(Abs(.Characters.Text = "LMNP"))
.Font.Color = Array(RGB(217, 217, 217), RGB(22, 54, 92))(Abs(.Characters.Text = "LMNP"))
End With
End Sub

cdt

Dranreb · Hier à 11:13

Comme ça, ça a l'air d'aller :

VB:

Sub LLI()
   Dim Obj As Object, N As Integer
   Set Obj = ActiveSheet.DrawingObjects(Application.Caller)
   On Error Resume Next
   N = WorksheetFunction.Match(Obj.Characters.Text, Array("LLI vide", "LMNP", "LLI"), 0)
   If Err Then N = 1
   On Error GoTo 0
   Obj.Characters.Text = Choose(N, "LMNP", "LLI", "LLI vide")
   Obj.Interior.Color = Choose(N, RGB(0, 158, 71), RGB(217, 217, 217), RGB(186, 186, 186))
   Obj.Font.Color = Choose(N, RGB(217, 217, 217), RGB(22, 54, 92), RGB(150, 150, 150))
   End Sub

job75 · Hier à 11:23

Avec DrawingObjects on utilise la propriété .Text :

VB:

Sub LLI()
Dim a, N
a = Array("LMNP", "LLI", "LLI VIDE")
With ActiveSheet.DrawingObjects("Rectangle : coins arrondis 1")
    N = Application.Match(.Text, a, 0)
    If IsError(N) Then
        MsgBox "Le texte de la forme doit être LMNP, LLI ou LLI VIDE, la casse est ignorée...", vbInformation
    Else
        .Text = UCase(a(N - 1)) 'majuscules
        .Interior.Color = Array(RGB(0, 158, 71), RGB(217, 217, 217), RGB(255, 192, 0))(N - 1)
        .Font.Color = Array(RGB(217, 217, 217), RGB(22, 54, 92), RGB(255, 0, 0))(N - 1)
    End If
End With
End Sub

mapomme · Hier à 11:36

Surtout pour tous vous saluer😉,

Donc un autre petit code (rien de bien original):

VB:

Sub LLI()
Dim valeurs, fonds, polices, n&
   valeurs = Split("LMNP,LLI,LLI vide", ",")                            ' liste des valeurs à considérer
   fonds = Array(RGB(0, 0, 0), vbRed, vbYellow, RGB(255, 255, 255))     ' couleurs selon les valeurs - chaque 1ère couleur
   polices = Array(RGB(255, 255, 255), vbWhite, vbCyan, RGB(0, 0, 255)) ' est appliquée si le texte n'est pas dans valeurs
   With ActiveSheet.DrawingObjects("Rectangle : coins arrondis 1")
      ' n = rang des couleurs à appliquer - n vaut 0 si le texte est différent d'un des éléments de valeurs
      n = Application.IfError(Application.Match(.Characters.Text, valeurs, 0), 0)
      .Interior.Color = fonds(n): .Font.Color = polices(n)     ' couleur du fond et de la police
   End With
End Sub

job75 · Hier à 11:39

On peut faire un carrousel :

VB:

Sub LLI()
Dim a, N
a = Array("LMNP", "LLI", "LLI VIDE")
With ActiveSheet.DrawingObjects("Rectangle : coins arrondis 1")
    N = Application.Match(.Text, a, 0)
    If IsError(N) Then
        MsgBox "Le texte de la forme doit être LMNP, LLI ou LLI VIDE, la casse est ignorée...", vbInformation
    Else
        If N < 3 Then N = N + 1 Else N = 1 'carrousel
        .Text = a(N - 1) 'majuscules
        .Interior.Color = Array(RGB(0, 158, 71), RGB(217, 217, 217), RGB(255, 192, 0))(N - 1)
        .Font.Color = Array(RGB(217, 217, 217), RGB(22, 54, 92), RGB(255, 0, 0))(N - 1)
    End If
End With
End Sub

pat66 · Hier à 11:56

re,

d'abord merci pour votre aide à tous

Job75 #10 avait raison, j'ai testé en remplaçant rectangle arrondi par rectangle et cela fonctionne, mais je souhaite conserver la forme arrondie

Je vais donc opter pour la solution de Dranreb du post #13 qui fonctionne, mais je garde aussi les autre solutions et vous en remercie

Pour compléter, cette solution, j'aimerai aussi pouvoir ajouter une boucle dans D90 avec la séquence suivante :
Si texte Rectangle : coins arrondis 1 = "LMNP", D90 = 10
Si texte Rectangle : coins arrondis 1 = "LLI",D90 = 0
Si texte Rectangle : coins arrondis 1 = "LLI vide",D90 = 0
etc....

merci beaucoup....

Dranreb · Hier à 12:08

Ajoutez une instruction :

VB:

   ActiveSheet.[D90].Value = Choose(N, 10, 0, 0)

mapomme · Hier à 12:09

pat66 à dit:
Pour compléter, cette solution, j'aimerai aussi pouvoir ajouter une boucle dans D90 avec la séquence suivante :
Si texte Rectangle : coins arrondis 1 = "LMNP", D90 = 10
Si texte Rectangle : coins arrondis 1 = "LLI",D90 = 0
Si texte Rectangle : coins arrondis 1 = "LLI vide",D90 = 0

pat66 · Hier à 15:04

Un grand merci à tous pour votre aide

cdt

Microsoft 365 Switcher entre 3 couleurs et 3 textes

pat66

XLDnaute Impliqué

Dranreb

job75

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

pat66

XLDnaute Impliqué

Discussions similaires

Microsoft 365 Switcher entre 3 couleurs et 3 textes

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency