XL 2016 VBA condition couleur dessin

Fenris · 16 Octobre 2017

Bonjour !

Je fais face à un problème épineux pour mes -très- maigres connaissances.

Je pose vite fait le décors.

Sur ma feuille 1, j'ai une centaine de lignes pour 3 colonnes. La première colonne donne le nom. La deuxième donne un nombre (1, 2, 3 ...). La troisième colonne dépend de la 2nd feuille.

Sur ma feuille 2, j'ai une centaine de dessins/forme. Chaque dessin dispose nombre identique à une ligne de la première feuille (celui de la 2eme colonne), afin de pouvoir les liés.

C'est là qu'on rentre dans le vif du sujet. Chaque dessin peut se voir attribuer une couleur (une trentaine de couleurs différentes). En fonction de la couleur du dessin, sa ligne associée dans la feuille 1 verra sa colonne 3 être changée. Exemple : la couleur 192 (rouge foncée) sera associé au chiffre 1, la couleur suivante (rouge) au 2 et ainsi de suite.

Ainsi, mon objectif est de n'avoir qu'à "colorier" (le coloriage, c'est tellement plus facile pour mon âme de fainéant

) les dessins pour mettre à jour la liste de la feuille 1. Ce qui sous entends le fait de pouvoir changer régulièrement la couleur des dessins.
Et sans que cela puisse bloquer le triage de mon tableau, si je souhaite trier via les chiffres de la colonne 2, 3, ou alphabétiquement

Petite précision, au vu du nombre de couleur nécessaire, je compte aussi utiliser les couleurs disponibles dans les thèmes, et donc leurs versions claires & foncées, ce qui doit probablement complexifier le tout.

Mais étant une quiche en VBA, et ne trouvant pas le moindre tuto pouvant m'aiguiller, je suis complètement bloqué. Je ne sais pas comment faire en sorte qu'un dessin soit associé à une ligne, ni comment faire en sorte qu'un changement de couleur du dessin se rapporte à la dite ligne.

Des pistes ?

Staple1600 · 16 Octobre 2017

Bonjour le fil, le forum

Des pistes?

Oui
Une
Joindre un fichier exemple (comme le conseille la charte du forum...)

Fenris · 16 Octobre 2017

Voilà un exemple qui se limite à 5 données/dessins et 3 couleurs. Le principe restant identique.

Dranreb · 16 Octobre 2017

Bonsoir.
Cette procédure dans le module Feuil1 semble faire ce que vous demandez :

VB:

Option Explicit

Private Sub Worksheet_Activate()
Dim Cel As Range, DicCoul As New Dictionary, TNoms(), L As Long, TRés(), _
   DicNoms As New Dictionary, Shp As Shape, Nom As String, Coul As Long
For Each Cel In Me.[H3:H5]: DicCoul(Cel.Interior.Color) = Cel.Offset(, 1).Value: Next Cel
TNoms = Me.[A2:A6].Value: For L = 1 To UBound(TNoms): DicNoms(TNoms(L, 1)) = L: Next L
ReDim TRés(1 To UBound(TNoms), 1 To 1)
For Each Shp In Feuil2.Shapes
   Nom = Shp.TextFrame.Characters.Text
   Coul = Shp.Fill.ForeColor
   If DicNoms.Exists(Nom) And DicCoul.Exists(Coul) Then
      TRés(DicNoms(Nom), 1) = DicCoul(Coul): End If
   Next Shp
Me.[C2:C6].Value = TRés
End Sub

Avec référence Microsoft Scripting Runtime cochée.

Fenris · 20 Octobre 2017

J'ai pris mon temps pour décortiquer votre procédure, mais je n'arrive pas à tout comprendre, ni à la faire fonctionner.
Notamment "Me", qui ne fonctionne pas sans que je comprenne pourquoi.

J'ai bien activé la référence MSC.

Sinon, petit détail par rapport à ce que j'ai pu comprendre, la référence d'une feuille à l'autre ne doivent pas se faire avec la colonne A, mais la colonne B pour la feuille 1. Et sur la feuille 2, c'est avec la "Zone nom" des dessins. Je préfère ça, car je peut ainsi inclure des annotations/code dans mes dessins.
En tout cas, si c'est possible.

Dranreb · 20 Octobre 2017

Bonjour.
C'est clair à mon avis, c'est parce que vous avez dû le mettre dans un module standard au lieu de le mettre dans le module de l'objet Worksheet Feuil1 qui représente dans VBA l'entité Excel qu'est la feuille portant aussi le nom "Feuil1" si ma mémoire est bonne (je n'ai pas ré-ouvert le classeur pour vérifier).

Fenris · 20 Octobre 2017

Effectivement. Je ne savais pas qu'un module standard et le module de la feuille 1 étaient différenciable, mais cela règle le problème du "Me".

Par contre, j'ai des erreurs de "Sub ou Function" non définie, notamment pour DicNoms(TNoms(L, 1)) si j'en crois la surbrillance, Nom et Coul qui sont des "Variables non définies".

J'avais aussi du faire face à des erreurs de syntaxe, (lignes 4:5 et lignes 12:14) que j'ai réglé, par la fusion des lignes 4 et 5 et en enlevant l'espace devant les lignes 12:14, mais j'ai peut être "cassé" d'autres choses en essayant de régler le soucis...

Dranreb · 20 Octobre 2017

Montrez ce que vous avez fait. TNoms, DicNoms, Nom et Coul sont déclarés dans le code proposé au #4 (dans la 2ième ligne du Dim, la 1ère se terminant par un " _" de continuation sur la suivante)

Fenris · 21 Octobre 2017

J'ai en rouge ces deux ensemble de ligne
Dim Cel As Range, DicCoul As New Dictionary, TNoms(), L As Long, TRés(), _
DicNoms As New Dictionary, Shp As Shape, Nom As String, Coul As Long

et

If DicNoms.Exists(Nom) And DicCoul.Exists(Coul) Then
TRés(DicNoms(Nom), 1) = DicCoul(Coul): End If
Next Shp

Donc pour y faire face, j'ai fais ça

Dim Cel As Range, DicCoul As New Dictionary, TNoms(), L As Long, TRés(), DicNoms As New Dictionary, Shp As Shape, Nom As String, Coul As Long

et j'ai supprimer les espaces devant chaque ligne suivante

If DicNoms.Exists(Nom) And DicCoul.Exists(Coul) Then
TRés(DicNoms(Nom), 1) = DicCoul(Coul): End If
Next Shp

Je ne savais pas trop comment supprimer les erreurs de syntaxe, donc j'ai un peu tâtonné jusqu'à ce que cette erreur n'apparaisse plus.

Dranreb · 21 Octobre 2017

Je n'avais aucune erreur de syntaxe chez moi. Joignez votre classeur.
Si une ligne doit être continuée sur la ligne suivante elle doit se terminer par un espace suivi d'un blanc souligné, tel que c'était dans le code que j'ai fourni à l'origine.

Fenris · 21 Octobre 2017

J'ignore complètement pourquoi Excel me signal des erreurs de mon coté. Ci-joint le classeur, avec le code présenté dans votre premier message.

Peut être faut il activer/désactiver une option supplémentaire, qui justifierais l'erreur de mon coté ?

Staple1600 · 21 Octobre 2017

Bonjour le fil, le forum

@Fenris
Est-ce que par hasard tu es sur Mac et non pas sur PC?
Ce qui expliquerait pourquoi chez toi, cela ne fonctionne pas

Fenris · 21 Octobre 2017

Pc, avec Windows 10 et excel 2016.

Dranreb · 21 Octobre 2017

Dans le classeur joint le problème vient de ce que des lignes commencent par des espaces insécable (code ascii 160) au lieu de commencer par des espaces (code ascii 32)

Staple1600 · 21 Octobre 2017

Re

@Fenris
J'ai ouvert ta pièce jointe
J'avais effectivement des lignes en rouge
J'ai fais en sorte de ne plus avoir de lignes rouges

VB:

Private Sub Worksheet_Activate()
Dim Cel As Range, DicCoul As New Dictionary, TNoms(), L As Long, TRés()
Dim DicNoms As New Dictionary, Shp As Shape, Nom As String, Coul As Long
For Each Cel In Me.[H3:H5]: DicCoul(Cel.Interior.Color) = Cel.Offset(, 1).Value: Next Cel
TNoms = Me.[A2:A6].Value: For L = 1 To UBound(TNoms): DicNoms(TNoms(L, 1)) = L: Next L
ReDim TRés(1 To UBound(TNoms), 1 To 1)
For Each Shp In Feuil2.Shapes
Nom = Shp.TextFrame.Characters.Text
Coul = Shp.Fill.ForeColor
If DicNoms.Exists(Nom) And DicCoul.Exists(Coul) Then
TRés(DicNoms(Nom), 1) = DicCoul(Coul): End If
Next Shp
Me.[C2:C6].Value = TRés
End Sub

PS: Tu as associé ton bouton à une procédure événementielle, ce n'est pas utile

EDITION: Houps, je n'avais pas rafraichi et donc vu le message de Dranred, bien plus concis que le mien

Effectuez une recherche sur Excel Downloads...

XL 2016 VBA condition couleur dessin

Fenris

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Fenris

XLDnaute Nouveau

Pièces jointes

Dranreb

XLDnaute Barbatruc

Fenris

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Fenris

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Fenris

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Fenris

XLDnaute Nouveau

Pièces jointes

Staple1600

XLDnaute Barbatruc

Fenris

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums