XL 2016 Montrer ou cacher deux familles de rectangles (seulement) sur une feuille

[Webperegrino]

Bonjour Le Forum,

Je cherche une alternance d’affichage de deux familles de Rectangles Jaunes et Verts, que je voudrais superposer ultérieurement.
Cette alternance se fera avec le choix de valeur dans la cellule G3.

J'ai un problème dans mon "Private Sub Worksheet_change(ByVal Target As Range)".

Ma variante de conception avec les deux boutons Masquer et Afficher (que je devrai supprimer de mon application) ne fonctionne pas non plus. J'avais essayé cette parade, le problème c'est que les rectangles bleus disparaissent aussi.

Pouvez-vous m’aider à corriger ma partie «"Private Sub Worksheet_change » ? ... pour que seulement les deux familles de rectangles Jaunes et Verts alternent dans l’affichage,
Merci

Webperegrino

 

[sylvanu]

Bonjour Webperegrino,
Pourquoi faire du .Visible dans la macro et du .Hidden dans la macro feuille ?
En PJ un essai avec :

Private Sub Worksheet_change(ByVal Target As Range)
    Dr1 = 10
    If [G3] = "Amb" Then Flag = False Else Flag = True
    For n = 1 To 5: ActiveSheet.Shapes("Rectangle " & n).Visible = Flag: Next n
    For n = 1 To 3: ActiveSheet.Shapes("Rectangle " & n + Dr1).Visible = Not (Flag): Next n
End Sub

Je ne suis pas sur du sens de masquage, à adapter.

Ou peut être plus convivial avec un Worksheet_SelectionChange ( PJ2) :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [G3]) Is Nothing Then
    Dr1 = 10
    If Target = "Amb" Then Flag = False Else Flag = True
        For n = 1 To 5: ActiveSheet.Shapes("Rectangle " & n).Visible = Flag: Next n
        For n = 1 To 3: ActiveSheet.Shapes("Rectangle " & n + Dr1).Visible = Not (Flag): Next n
        If Target = "Amb" Then Target = "Fixe" Else Target = "Amb"
        Range(Target.Address).Offset(1, 0).Select
    End If
End Sub

 

[Webperegrino]

Le forum,
Bonsoir Sylvanu.
Quel miracle pour moi !
Deux solutions de surcroît, me voilà avec l'embarras du choix.
En effet, avec la PJ2, cela semble plus rapide et convivial.
Ces deux applications vont parfaitement résoudre mes conflits dans mon "application Usine à gaz" qui va les recevoir.
Merci Sylvanu, longue vie au Forum avec toutes ces aides pour nous faire progresser.
Excel-lent week-end à vous,
Cordialement,
Webperegrino

 

[Webperegrino]

Le Forum,
Re-Sylvanu,
La version "PJ2" vient d'être appliquée dans mon gros fichier...
Les rectangles de la deuxième famille ont été superposés sur ceux de la première famille.
Vos lignes de VBA y font des merveilles ! La bascule des rectangles est fantastique.
J'imagine déjà plein d'applications nouvelles de votre codification.
Quel résultat simple, rapide et net !
Encore merci à vous,
Bien cordialement,
Webperegrino

 

[Webperegrino]

Bonjour Le Forum,
Bonjour Sylvanu,
Je me permets d'intervenir une dernière fois au sujet de la mise en couleur de ma deuxième famille de Rectangles que je cherche à réaliser en fonction des couleurs en feuille Paramètres.
J'ai placé ceci dans la codification, mais cela coince.
Existe-til une parade ?
Merci
Webperegrino

For n = 1 To Dr2
ActiveSheet.Shapes("Rectangle " & n + Dr1).visible = Not (Flag)
For lgPar = 2 To Dr2
'MsgBox Par.Cells(lgPar, 27) ' & " / " & ActiveSheet.Shapes("Rectangle " & n + Dr1)
' j'ai essayé avec  .Text ou encore .Caption
If Par.Cells(lgPar, 27) = ActiveSheet.Shapes("Rectangle " & n + Dr1) Then 'GLUPSS !!!
ActiveSheet.Shapes("Rectangle " & n + Dr1).Interior.Color = Par.Cells(lgPar, 27).Interior.Color
ActiveSheet.Shapes("Rectangle " & n + Dr1).Font.Color.Index = Par.Cells(lgPar, 27).Font.Color.Index
End If
Next lgPar
Next n

 

[sylvanu]

Bonjour Webperegrino,
Pour les shapes, utilisez pour les couleurs :

.Fill.ForeColor.RGB  pour le fond
.Line.ForeColor.RGB  pour les bordures

et pour l'épaisseur des bordures :

.Line.Weight = X

Dans cette PJ vous pouvez choisir par clic la couleur de fond et de bordures, ainsi que l'épaisseur de la bordure.

 

[Webperegrino]

Le Forum,
Bonsoir Sylvanu,
J'essaie d'extraire une partie de mon fichier "destination" pour vous montrer le blocage... et je reviens vers vous avec ce fichier limité à cette recherche de couleurs des rectangles en fonction des couleurs dans la colonne de la feuille Paramètres.
Merci pour votre approche que j'ai essayé d'appliquer, mais ma soirée est prise par d'autres occupations, désolé.
Webperegrino

 

[Webperegrino]

Le Forum,
Sylvanu,
J'avais essayé de cacher les infos de Paramètres pour la mise à jour du texte des Rectangles de feuille Caisse, mais la mise à jour ne se fait pas ici mais parfaitement dans mon Application réelle.
Tant pis on va faire comme cela.
Voici une approche de la mise en place de vos quatre lignes qui ont bloqué la mise automatique en couleur des Rectangles "Ambulants". Le fichier ne contient pas tout, juste le nécessaire pour votre code de couleur de fond et de police.
Ce fichier servira à mon épouse qui a en charge une équipe de bénévoles, elle-même bénévole.
Cordialement,
Webperegrino

 

[Webperegrino]

Le Forum,
Sylvanu,
J'ai rétabli les bonnes listes dans Paramètres, pour une meilleure compréhension.
J'ai remis la chose en #8.
Webperegrino

 

[sylvanu]

Bonsoir Webperegrino,
Effectivement ça a bien avancé.
Je n'ai pas compris, il y a un problème sur lequel vous butez et vous aimeriez une aide, ou est ce un fichier d'avancement ?


PS :
Comme ill y a des questions assez récurrentes sur les shapes, j'ai fait un tout petit tuto pour débuter.
Je le livre ici, cela pourra servir éventuellement aux futurs lecteurs.

 

[Webperegrino]

Le Forum,
Sylvanu,
Bonjour et merci pour votre réponse,
Dans la version ci-jointe, je viens de réactiver vos lignes de codes que vous m'aviez proposé d'installer.

Du coup, il y a blocage :
- les couleurs placées en colonne AA de la Feuille "Paramètres" ne mettent malheureusement pas à jour celles des Rectangles "AMBULANTS" de la Feuille "Caisse".

- la macro bloque à ce stade
- cela m'obligerait à corriger ces couleurs manuellement, Rectangle après Rectangle...

C'est de ce stade que je désire recevoir une nouvelle hypothèse de correction.

Votre tuto #10 est très pratique, je vais m'en servir, Grand merci.

Cordialement,
Webpregrino

 

[sylvanu]

Bonjour,
Je viens juste d'ouvrir votre PJ.
Avant même d'essayé de comprendre, j'ai é un point.
Lors de l'erreur sur la ligne incriminée on a ceci :

Donc à ce moment là "n" est vide, donc "AA" & n ne veut rien dire, d'où l'erreur.
Il faut qu'à ce moment là "n" ait une valeur connue.
Je continue ...

De plus, cette ligne de code est dans la feuille Caisse, et vous cherchez si la cellule cliquée est en feuille Paramètres, ce qui n'est pas possible. Donc de toute façon, il y a un souci.

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.

 

[Webperegrino]

Sylvanu,
Si je mets ceci à la place, le résultat n'est pas plus favorable ...

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).Fill Then
    ActiveSheet.Shapes("Rectangle " & n + Dr1).Fill.ForeColor.RGB = Par.Range("AA" & n).Couleur
  End If
Next n

Webperegrino

 

[Webperegrino]

Glupps, je n'ai pas eu le temps de lire #12...
Ce que je n'arrive pas à rectifier c'est ceci, la ligne de code:
- "si le Rectangle Caisse rencontre la même dénomination d'une cellule de colonne AA de Paramètres, alors on applique la couleur de la cellule de AA Paramètres".

 

[sylvanu]

Par.Range("AA" & n)

Est une adresse de cellule

ActiveSheet.Shapes("Rectangle " & n + Dr1).Fill

Est une action : Remplir.
Donc il ne peut y avoir égalité.