Macro couleur de formes Résolu

Question

Bonjour, Je récupère une macro qui jusqu'à présent fonctionne très bien, simplement en voulant étendre son champ d'utilisation cela ne fonctionne pas. Je m'explique: A l'origine la macro colorie une freeform (régions de France), fait apparaître des objets (flèches) en fonction de la valeur de chaque mois de l'année. Aujourd'hui je souhaite utiliser exactement le meme mode fonctionnement mais j'ai rajouté une deuxième carte de France (les freeform sont nommées différemment) qui se colorie en fonction d'autres valeurs. J'ai donc repris la meme macro et changé les valeurs (j'ai certainement du en oublier vu que cela ne fonctionne pas) Est ce que quelqu'un pourrait m'aider svp en apportant les modifs à la macro ci dessous ? Merci d'avance. 'Programmation moisTF (fonctionne) Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Mois As String Dim i As Integer Dim DR As String Dim TxFreq, TxMoisEnCours, TxMoisPrec As Variant Set wk = ActiveWorkbook Set Source = wk.Sheets("2012") Set param = wk.Sheets("parametrage TdB") Set TDB = wk.Sheets("Tableau de bord") Mois = TDB.Range("I8").Value 'régions For i = 1 To 61 DR = Source.Cells(i, 1) 'Taux TxFreq = Source.Cells(i + 10, 14) 'mois For a = 2 To 13 If Source.Cells(i + 1, a) = Mois Then TxMoisEnCours = Source.Cells(i + 10, a) TxMoisPrec = Source.Cells(i + 10, a - 1) End If Next a Couleur DR, TxFreq Fleche DR, TxMoisEnCours, TxMoisPrec, Mois i = i + 14 Next i End Sub 'Programmation couleur TF (fonctionne) Function Couleur(Région, Tx) As Integer Set wk = ActiveWorkbook Set Source = wk.Sheets("2012") Set param = wk.Sheets("parametrage TdB") Set TDB = wk.Sheets("Tableau de bord") Select Case Tx Case Is < param.Cells(3, 2) Couleur = param.Cells(3, 3) Case Is > param.Cells(4, 2) Couleur = param.Cells(5, 3) Case Else Couleur = param.Cells(4, 3) End Select For b = 41 To 45 If param.Cells(b, 1) = Région Then x = 2 Do While param.Cells(b, x) <> 0 nom = "Freeform " & param.Cells(b, x) TDB.Shapes(nom).Fill.ForeColor.SchemeColor = Couleur x = x + 1 Loop End If Next End Function 'Programmation fleches TF (fonctionne) Function Fleche(Région, TxEncours, TxPrec, MoisVal) Set wk = ActiveWorkbook Set Source = wk.Sheets("2012") Set param = wk.Sheets("parametrage TdB") Set TDB = wk.Sheets("Tableau de bord") If MoisVal <> "JANVIER" Then test = TxEncours - TxPrec Select Case test Case Is < 0 vtest = 1 Case Is > 0 vtest = 2 Case Is = 0 vtest = 3 End Select Else vtest = 0 End If For b = 49 To 53 If param.Cells(b, 1) = Région Then For y = 1 To 3 nom = param.Cells(48, y + 1) & " " & param.Cells(b, y + 1) If y = vtest Then TDB.Shapes(nom).Visible = True Else TDB.Shapes(nom).Visible = False End If Next y End If Next b End Function (CE QUI SUIT EST CE QUE JE SOUHAITE RAJOUTER MAIS NE FONCTIONNE PAS) Private Sub Workbook_SheetChange2(ByVal Sh As Object, ByVal Target As Range) Dim Mois As String Dim i As Integer Dim DR As String Dim TxGrav, TxMoisEnCours, TxMoisPrec As Variant Set wk = ActiveWorkbook Set Source = wk.Sheets("2012") Set param = wk.Sheets("parametrage TdB") Set TDB = wk.Sheets("Tableau de bord") Mois = TDB.Range("I8").Value 'régions For i = 1 To 61 DR = Source.Cells(i, 1) 'Taux TxGrav = Source.Cells(i + 11, 14) 'mois For a = 2 To 13 If Source.Cells(i + 1, a) = Mois Then TxMoisEnCours = Source.Cells(i + 11, a) TxMoisPrec = Source.Cells(i + 11, a - 1) End If Next a Couleur DR, TxGrav Fleche DR, TxMoisEnCours, TxMoisPrec, Mois i = i + 14 Next i End Sub 'programmation couleur TG Function Couleur2(Région, Tx) As Integer Set wk = ActiveWorkbook Set Source = wk.Sheets("2012") Set param = wk.Sheets("parametrage TdB") Set TDB = wk.Sheets("Tableau de bord") Select Case Tx Case Is < param.Cells(8, 2) Couleur = param.Cells(8, 3) Case Is > param.Cells(9, 2) Couleur = param.Cells(10, 3) Case Else Couleur = param.Cells(9, 3) End Select For b = 58 To 62 If param.Cells(b, 1) = Région Then x = 2 Do While param.Cells(b, x) <> 0 nom = "Freeform " & param.Cells(b, x) TDB.Shapes(nom).Fill.ForeColor.SchemeColor = Couleur x = x + 1 Loop End If Next End Function Configuration: Windows 7 / Safari 536.5

Le Pingou · Answer

Bonjour,
Sans le fichier qui si rattache c'est pratiquement impossible de trouver ou il y a une faute dans la procédure. Pouvez-vous mettre le fichier sur https://www.cjoint.com/  et poster le lien ?

Guillaume · Answer

Merci d'avance.

http://cjoint.com/?3EvndVyVip7 


Cordialement

Le Pingou · Answer

Bonjour,
Merci pour le fichier.
Je n'ai encore pas trouvé comment le faire fonctionner ... les deux boutons sur la feuille [Tableau de bord] ne provoquent qu'une erreur ... !
En cherchant dans le code je ne trouve pas non plus les macros que vous avez montrées dans votre premier message... !
Que dois-je faire... !

En marge, est-ce que vous êtes "Guillaume" ou "Gui" ??

Guillaume · Answer

rebonjour, 

Oui pardon pour le pseudo, il s'agit bien de la même personne.

Les copies des codes sont dans la page Thisworkbook de VBA.

Concernant les 2 boutons qui génèrent une erreur c'est normal, vous n'avez ici qu'un extrait de la base et j'ai seulement oublié de supprimer cette zone.
Le seul bouton qui m'intéresse est le choix multiple de mois pour animer les cartes selon le mois sélectionné.

Je vous renvoie le lien avec la base corrigée.

Merci d'avance pour votre aide.

Guillaume · Answer

http://cjoint.com/data3/3Evr0aMtTIH.htm

gbinforme · Answer

bonjour Gui llaume, Le Pingou,

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 

Ceci est une macro événementielle dans Thisworkbook.

Si tu rajoutes celle-ci :

Private Sub Workbook_SheetChange2(ByVal Sh As Object, ByVal Target As Range) 
elle n'a aucune chance de se lancer car elle n'est pas connue d'excel en tant qu'événementielle.

Si tu veux la faire fonctionner il faut l'inclure dans la première et faire en sorte que le processus fonctionne correctement.

Le Pingou · Answer

Bonjour,
Merci pour le supplément d'information.
La réponse va suivre, patience.
Salutations 
Le Pingou

Le Pingou · Answer

Bonjour,
Contrôler pour voir si c'est comme vous le désirez :  https://www.cjoint.com/?3EvvDvb6iCH
Note : je n'ai pas trouvé de code pour renseigner les [TextBox1] à [TextBox10] !!
Je ferai la correction définitive dès votre réponse.

Guillaume · Answer

Bonjour, 

Un grand merci dans l'idée c'est ce que je recherche.  Par contre pensez vous qu'il est possible d'organiser les couleurs des régions comme les fleches ? Cad la couleur en fonction du mois sélectionné.

j'ai d'ailleurs préparé les noms des flèches pour le tableau de droite pour vous faciliter la tache. Veuillez trouver ci dessous le nouveau tableau

http://cjoint.com/?3Ewj5TYR0f3

encore merci et bon courage

Le Pingou · Answer

Bonjour,
Merci pour l'information.
Votre fichier est presque terminé, je vais comparer avec ces nouvelles informations (Par contre pensez-vous qu'il est possible d'organiser les couleurs des régions comme les flèches ? Cad la couleur en fonction du mois sélectionné) ... !
J'ai par contre 2 questions :
La procédure [Private Sub Workbook_SheetChange(...)] n'a pas de contrôle sur l'origine du déclenchement (soit le changement de mois dans la feuille [Tableau de bord]) d'où chaque fois que vous modifier une cellule de n'importe quelles feuilles la procédure est exécutée inutilement ... ! 
Pourquoi ne pas utiliser la procédure [Private Sub Worksheet_Change(ByVal Target As Range)] placé directement dans le module de la feuille concernée [Tableau de bord] ... !

Le Pingou · Answer

Bonjour,
Pouvez-vous contrôler le nouveau lien car cela ne fonctionne pas ?
Merci.

Le Pingou · Answer

Bonjour,
Dans l'attente de votre réponse aux 2 messages précédents, je vous laisse la découverte : https://www.cjoint.com/?3EwloXAg47t

Guillaume · Answer

Bonjour, 

Je viens de voir votre super travail, du coup vous n'avez plus besoin de mon lien.

Vous avez raison nous pourrions limiter le déclenchement de la macro à la feuille concernée.

Cordialement

Le Pingou · Answer

Bonjour,
Merci, je vous prépare une version dans ce sens.
Si possible en fin de journée.

Le Pingou · Answer

Bonjour,
Concernant l'attribution de la couleur, vous utilisez le taux de fréquence de la colonne 14 [N], est-ce correct ... ou faut-il prendre le taux cumulé du mois concerné ... ?
Merci de votre réponse.

Guillaume · Answer

Bonsoir, effectivement je cherche a prendre le taux de fréquence cumulé du mois concerné

Guillaume · Answer

de meme avec les TG.

merci

Le Pingou · Answer

Bonjour,
Merci pour les réponses.
Je vous laisse essayer et contrôler l'exactitude des valeurs.
Votre fichier adapté : https://www.cjoint.com/?3Ewwbo7rMiX
Note : la procédure principale est dans le module de la feuille [Tableau de bord], les 3 `'Function `' (qui en fait n'en sont pas...) sont transformées en procédure [Sub()] et placées dans le module [lepingou]
Le module [ThisWorkbook] est vide et les anciennes procédures sont dans le module [OLD].

Guillaume · Answer

Bonjour, 

C'est exactement ce que j'attendais merci beaucoup pour votre aide.
Je termine le tableau de bord et reviens vers vous si jamais j'ai un problème.

Encore merci et une excellente journée à vous.

Cordialement

Le Pingou · Answer

Bonjour,
Merci pour l'information.
Note : la cellule pour le choix du mois est nommée [chxmois], ce nom est utilisé comme contrôle dans la procédure principale .... Pensez-y pour votre fichier de travail.

Guillaume · Answer

Bonsoir,

Merci j'ai pu adapter votre travail à ma base principale, tout fonctionne !!!!

Je profite de votre savoir-faire pour vous poser une nouvelle question.

Voila j'ai une autre base qui regroupe un certain nombre de dates (date "réalisation action" et date "fin de validité").
Je cherche a faire 2 choses:
1. Lorsque j'inscrit la date de réalisation: que la date de fin de validité s'affiche automatiquement en fonction d'une fréquence définie
2. Mettre en place une MFC selon l'écart entre la date de fin de validité et la date d'aujourd'hui. (exemple: fréquence de 3ans entre les 2 dates donc VERT si écart>1an; JAUNE si < date AUJOURDHUI et <1an ; ROUGE > date AUJOURDHUI.

Bien sur pour la 2nd question j'ai essayé une MFC avec formule, cela fonctionne sauf que lorsque je copie/colle des cellules extérieures ma MFC est effacée.

Dans l'espoir que vous pourrez m'aider comme précédemment, un grand merci d'avance.

Le Pingou · Answer

Bonjour,  
Avec un exemple / extrait du fichier se sera plus simple de vous proposer une solution. 
Et de quelle manière :  je copie/colle des cellules extérieures ma MFC ? 

Salutations.  
Le Pingou

Guillaume · Answer

Oui bien sur, 

http://cjoint.com/?3EyjOTafnYP

Cordialement

Le Pingou · Answer

Bonjour,
Merci.
Il me manque la réponse à ceci : Et de quelle manière :  je copie/colle des cellules extérieures ma MFC ?

Le Pingou · Answer

Bonjour, 
Petite question, la date et sa validité sont attribuées à une personne, alors pourquoi ne pas travailler directement sur la colonne [Date dernière formation] de la feuille [Feuil2] en utilisant un formulaire (UseForm] pour renseigner la date ? 

Salutations. 
Le Pingou

Le Pingou · Answer

Bonjour,
Dans votre exemple en feuille 1 le délai est de + 2 ans alors je pense que ceci n'est pas correct :
. (Exemple: fréquence de 3ans entre les 2 dates donc VERT si écart>1an; JAUNE si < date AUJOURDHUI et <1an ; ROUGE > date AUJOURDHUI.
Merci de le reformuler !

Guillaume · Answer

en fait cela depend de la formation {2, 3 ou 5 ans} donc pas vraiment d'importance pour l'exemple. je les adapterai sur ma base selon les cas

Le Pingou · Answer

Bon jour,
Merci.
J'attends toujours les réponses aux messages 25 et 26 ... !

Guillaume · Answer

Bonsoir, merci pour la relance, par contre j'ai fait une réponse à 20.06.

Je ne sais qu'elles sont les messages 25 et 26. 

Je vais répondre à tous les points:
1.  Il me manque la réponse à ceci : Et de quelle manière : je copie/colle des cellules extérieures ma MFC ? 
          . Copier manuellement (clic droit) les dates de la feuille 1 et coller manuellement (clic droit)en feuille 2.
2.  a date et sa validité sont attribuées à une personne, alors pourquoi ne pas travailler directement sur la colonne [Date dernière formation] de la feuille [Feuil2] en utilisant un formulaire (UseForm] pour renseigner la date ? 
            . Dans notre organisation interne nous avons 2 dossier différent pour de multiples raisons, la feuille 1 est une base et la feuille 2 en est une autre.

Merci et n'hésitez pas à me relancer si vous avez la moindre question.

Le Pingou · Answer

Bonjour,
Votre exemple et prenez soin d'appliquer le conseil de gbinforme.
https://www.cjoint.com/?3EyxPDpkFoh

Le Pingou · Answer

Bonjour,
Dans le but d'éviter un oubli lors du copier/coller, j'ai rajouté une option via une procédure.
Votre fichier avec l'ajour : https://www.cjoint.com/?3Ezphlytn0j

guillaume · Answer

Je viens de regarder votre travail
C'est exactement ce qu'il me fallait, encore un grand merci le pingou

Guillaume · Answer

Bonjour, 

Vous m'avez bien aidé pour mon tableau de bord;

Une erreur apparaît lorsque je clic sur les flèches de défilement des commentaires.

Je n'arrive pas à la corriger, pourriez vous s'il vous plait m'indiquer la démarche à suivre afin que je puisse corriger sur le tableau de bord original.

Merci d'avance.

le fichier se trouve à l'adresse ci dessous*

http://cjoint.com/?3Ftsaye6vMB

Cordialement

Le Pingou · Answer

Bonjour,
Je regarderai en fin de journée.

Le Pingou · Answer

Bonjour,
Modifier la procédure de la [Toupie] comme suit :
Private Sub SpinButton1_Change()
Application.EnableEvents = False
If SpinButton1.Value < (Sheets("Tableau de bord").Cells(32, 16) - 5) Then
Sheets("Tableau de bord").Cells(32, 14) = SpinButton1.Value
Else
SpinButton1.Value = SpinButton1.Value - 1
End If
Application.EnableEvents = True
End Sub

Macro couleur de formes - Page 2

Discussions similaires

Newsletters