Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 

Pièces jointes

  • 1_Essai Rectangles Montés Cachés.xlsm
    21.5 KB · Affichages: 4
Dernière édition:
Trier par date Trier par votes

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Webperegrino,
Pourquoi faire du .Visible dans la macro et du .Hidden dans la macro feuille ?
En PJ un essai avec :
VB: 
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) :
VB: 
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
 

Pièces jointes

  • 1_Essai Rectangles Montés Cachés.xlsm
    20.6 KB · Affichages: 2
  • 1_Essai Rectangles Montés Cachés (2).xlsm
    21 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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


VB: 
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
 
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Webperegrino,
Pour les shapes, utilisez pour les couleurs :
VB: 
.Fill.ForeColor.RGB  pour le fond
.Line.ForeColor.RGB  pour les bordures
et pour l'épaisseur des bordures :
VB: 
.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.
 

Pièces jointes

  • 1_Essai Rectangles Montés Cachés (V3).xlsm
    22.5 KB · Affichages: 2
Dernière édition:
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 

Pièces jointes

  • Gestion couleurs entre RectanglesCaisse et Couleurs_FeuilParam.xlsm
    44.1 KB · Affichages: 1
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

Pièces jointes

  • 6- Tuto - Shapes.xlsm
    52.8 KB · Affichages: 2
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 

Pièces jointes

  • 1_Gestion couleurs entre RectanglesCaisse et Couleurs_FeuilParam.xlsm
    43.3 KB · Affichages: 1
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 
Dernière édition:
Vote positif 0 Vote négatif
W

Webperegrino

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

VB: 
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
 
Vote positif 0 Vote négatif
W

Webperegrino

XLDnaute Impliqué
Supporter XLD
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".
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

W
  • Résolu(e)
XL 2016 Ordonner une cellule ou un pavé de cellules contenant des chr(10)
Réponses
5
Affichages
521
Webperegrino
W
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…