XL 2016 Mettre en couleur des images avec VBA

[Dorileo]

Salut à tous,

Je pensais pouvoir résoudre mon problème mais j'ai le cerveau en marmelade, je déclare forfait ! j'ai besoin de vrais pros.
Voilà mon problème.
Dans l'onglet DATA, j'ai un tableau avec une liste de département + des colonnes de postes électriques ( PAC4, PAC5, PF4S, etc...)
Selon la colonne du poste, un transporteur apparait dans la colonne selon son meilleur placement tarifaire sur le département.
J'essaie depuis la nuit des temps de coloriser une carte de France selon chaque poste avec le transporteur qui a la meilleure offre sur un département.
Afin d'avoir un visuel sur chaque carte...il y en a aura 8 cartes au total.
J'essaie de m'inspirer d'un code qui pourrait me convenir pour mon besoin ... mais je ne capte rien! ça beeeeuuug !!! snif, je triture le code VBA mais erreur de syntaxe en file indienne...re snif !
Le lien ci-dessous auquel j'essaie d'adapter mon besoin.
https://www.experts-excel.com/excel/tuto-excel-vba-mettre-en-couleur-des-images/
J'essaie de mettre ce code en macro volatile sans bouton, afin que les cartons se mettent à jour toutes seules.
Si un cerveau brillant peut me venir en aide, vous me sauvez d'un piètre situation....merci à tous !
Et longue vie à EXD, je kiffe ce site...
A votre dispo pour toutes questions...
Thierry

 

[Dranreb]

Bonsoir.
Ce que je vois d'abord c'est que vous tentez d'utiliser un nom de feuille Excel "Data" en tant que nom d'objet Worksheet qui assumerait pour VBA la représentation de cette feuille. Or celle ci n'est pas un objet VBA mais une entité de l'application hôte, laquelle vous en a bien installé un, mais qui s'appelle Feuil4, pas Data.
Notez que dans la 1ère ligne de la fenêtre de propriété de cet objet vous pouvez le renommer Data si vous voulez. Dans VBE pas dans Excel. Personnellement je le renommerais WshData parce que je préfixe toujours d'un trigramme les noms d'objets VBA.

 

[Dorileo]

Bonsoir.
Ce que je vois d'abord c'est que vous tentez d'utiliser un nom de feuille Excel "Data" en tant que nom d'objet Worksheet qui assumerait pour VBA la représentation de cette feuille. Or celle ci n'est pas un objet VBA mais une entité de l'application hôte, laquelle vous en a bien installé un, mais qui s'appelle Feuil4, pas Data.
Notez que dans la 1ère ligne de la fenêtre de propriété de cet objet vous pouvez le renommer Data si vous voulez. Dans VBE pas dans Excel. Personnellement je le renommerais WshData parce que je préfixe toujours d'un trigramme les noms d'objets VBA.

Bonsoir Dranreb,
Merci pour vos précieux conseils, j'ai compris mon erreur ! mais j'ai toujours une erreur d'exécution sur la ligne 'Set Plage = Data.ListObjects(“TdBornes”).DataBodyRange.Columns(1)

J'essaie d'exploiter le code VBA trouvé sur un site

Sub Coloration()
Dim Cel As Range, Rng As Range, Plage As Range
Dim Shp As Shape
Set Plage = Feuil1.ListObjects(“TbBornes”).DataBodyRange.Columns(1)
‘ — Boucle sur les département
For Each Cel In Feuil1.ListObjects(“TbValeurs”).DataBodyRange.Columns(1).Cells
‘ — Image
Set Shp = Feuil1.Shapes(“_” & Format(Cel.Value, “00”))
‘ –- Couleur par défaut
Shp.Fill.ForeColor.RGB = Plage.Cells(Plage.Cells.Count).Offset(0, 1).Interior.Color
‘ — Recherche de la valeur dans la table
For Each Rng In Plage.Cells
If Cel.Offset(0, 2).Value <= Rng.Value Then
‘ — Mise en couleur
Shp.Fill.ForeColor.RGB = Rng.Offset(0, 1).Interior.Color
Exit For
End If
Next Rng
Next Cel
End Sub

J'ai modifié Feuil1 en renommant Data dans la fenêtre propriété.
Plusieurs questions m'interceptent :
- Mes tables TdValeurs et TdBornes sont elles biens choisies ?
- J'ai un doute sur ma carte de France, il parle Pour que le code puisse fonctionner correctement, il faut faire créer une clef de correspondance entre le tableau et les images. Il faut donc nommer chaque image (« _00 »). Je dois bien créer chaque image de mes département par un nom _01, _02, _03...etc..

Pas simple mon histoire ...
Merci

 

[Dorileo]

Une légère mise à jour du fichier

 

[Dranreb]

Les ListObject de votre Data ne s'appellent pas "TdBornes" et "TdValeurs" mais "Tableau2" et "Tableau1".
Vous pouvez renommer ces tableaux via le menu Création de tableau.
Vous utilisez de bien curieuses apostrophes comme délimiteurs de constantes String !
Pourquoi y a-t-il 4 cartes de France qui s'appellent toutes "_00" ?
Et pourquoi la macro est affectée aux sous formes qui les composent ?

 

[Dorileo]

Les ListObject de votre Data ne s'appellent pas "TdBornes" et "TdValeurs" mais "Tableau2" et "Tableau1".
Vous pouvez renommer ces tableaux via le menu Création de tableau.
Vous utilisez de bien curieuses apostrophes comme délimiteurs de constantes String !
Pourquoi y a-t-il 4 cartes de France qui s'appellent toutes "_00" ?
Et pourquoi la macro est affectée aux sous formes qui les composent ?

Je suis largué ... je vais prendre un autre chemin !, à force de tenter un millier de choses, je finis par ne plus comprendre ce que je fais sur ce fichier.
En fait, j'ai besoin de 8 cartes de France.
Chaque carte de France représente une colonne du tableau PAC4 , PAC5, PF4S..etc
Elles doivent se coloriser selon la couleur et la ligne de département qui compose sa colonne.
Mon projet est trop complexe pour avoir ce résultat...j'ai mis la barre trop haute pour mon niveau trop fragile.
J'ai certainement commis des erreurs comme vous le précisez ... carte nommez en _00 ! j'ai dû tenter un truc.
Je ne maîtrise pas encore assez le VBA, je tenté d'adapter ce fameux code sur mon fichier mais le site qui le partage n'est pas très explicite ...
Je vais colorier mes cartes à la mano ...
Merci pour le temps que vous avez partagé sur ma problématique...
Sincères salutations
Bien à vous

 

[Dranreb]

Oui, ben il ne faut pas qu'elles portent toutes le même nom, ici "_00" sinon on ne va pas savoir comment en atteindre une en particulier !
Par ailleurs, Je prend au hasard le département où j'habite, c'est le seul qui s'appelle "FR-90" au lieu de "_90" selon la logique des autres !
Ayant renommé "CartePAC4" la première "_00", j'ai pu le sélectionner avec cette petite macro de test :

Sub Test()
   Dim ShpCarte As Shape, ShpDpt As Shape
   Set ShpCarte = Data.Shapes("CartePAC4")
   Set ShpDpt = ShpCarte.GroupItems("FR-90")
   ShpDpt.Select
   End Sub

 

[Dorileo]

Oui, ben il ne faut pas qu'elles portent toutes le même nom, ici "_00" sinon on ne va pas savoir comment en atteindre une en particulier !
Par ailleurs, Je prend au hasard le département où j'habite, c'est le seul qui s'appelle "FR-90" au lieu de "_90" selon la logique des autres !
Ayant renommé "CartePAC4" la première "_00", j'ai pu le sélectionner avec cette petite macro de test :

Sub Test()
   Dim ShpCarte As Shape, ShpDpt As Shape
   Set ShpCarte = Data.Shapes("CartePAC4")
   Set ShpDpt = ShpCarte.GroupItems("FR-90")
   ShpDpt.Select
   End Sub

Le FR-90 a dû m'échapper quand j'ai renommé les dept en _01, _02...etc, le hasard fait bien les choses...lol
J'avais nommé au départ la Carte en CartePAC4 selon le nom d'une colonne mais je suis perdu ailleurs par la suite...
Je vais essayer de comprendre votre code pour le développer sur toute la carte...merci pour votre partage, et de me faire grandir dans le milieu du VBA...votre culture est précieuse !
Merci

 

[Dorileo]

Bonsoir Dranreb,
Merci pour vos précieux conseils, j'ai compris mon erreur ! mais j'ai toujours une erreur d'exécution sur la ligne 'Set Plage = Data.ListObjects(“TdBornes”).DataBodyRange.Columns(1)

J'essaie d'exploiter le code VBA trouvé sur un site

Sub Coloration()
Dim Cel As Range, Rng As Range, Plage As Range
Dim Shp As Shape
Set Plage = Feuil1.ListObjects(“TbBornes”).DataBodyRange.Columns(1)
‘ — Boucle sur les département
For Each Cel In Feuil1.ListObjects(“TbValeurs”).DataBodyRange.Columns(1).Cells
‘ — Image
Set Shp = Feuil1.Shapes(“_” & Format(Cel.Value, “00”))
‘ –- Couleur par défaut
Shp.Fill.ForeColor.RGB = Plage.Cells(Plage.Cells.Count).Offset(0, 1).Interior.Color
‘ — Recherche de la valeur dans la table
For Each Rng In Plage.Cells
If Cel.Offset(0, 2).Value <= Rng.Value Then
‘ — Mise en couleur
Shp.Fill.ForeColor.RGB = Rng.Offset(0, 1).Interior.Color
Exit For
End If
Next Rng
Next Cel
End Sub

J'ai modifié Feuil1 en renommant Data dans la fenêtre propriété.
Plusieurs questions m'interceptent :
- Mes tables TdValeurs et TdBornes sont elles biens choisies ?
- J'ai un doute sur ma carte de France, il parle Pour que le code puisse fonctionner correctement, il faut faire créer une clef de correspondance entre le tableau et les images. Il faut donc nommer chaque image (« _00 »). Je dois bien créer chaque image de mes département par un nom _01, _02, _03...etc..

Pas simple mon histoire ...
Merci

 

[Dorileo]

Bonjour Dranreb,

Comment allez-vous ?
J'ai refait mon fichier autrement.
J'ai mis mes fameuses 8 cartes de france qui s'actualiseront avec un bouton à chacun, le fichier test n'en comporte que 2 car trop volumineux à joindre.
Mais petit problème que je ne capte pas, quand je clique sur le bouton PAC4, il colorise bien les départements selon la lecture du tableau.
Mais quand je clique sur le bouton PAC5, il prend les bonnes données du tableau mais vont coloriser sur la carte du PAC4 au lieu du PAC5.
J'ai essayé dans les sens des changements dans les codes VBA mais sans succès.
Ça ne tient pas à grand chose ... mais je ne vois pas la source du problème.
Vous voyez quelque chose qui vous saute aux yeux ?
1000 mercis

 

[Dranreb]

Bonjour
Vous n'avez apparemment pas compris que lorsqu'un Shape est un groupe il faut impérativement passez par sa collection GroupItems pour atteindre ceux qui le composent.

 

[patricktoulon]

bonjour
on pourrait faire avec une seule carte et une liste de validation

 

[Dorileo]

Salut Patrick,
Mon responsable veut 8 cartes pour chaque cas ... Sont folle dingue dans ma boutique ...
Votre solution m'aurait bien intéressé ... une seule carte me fait apparaitre 8 autres avec une liste validation ?
J'essaie de comprendre le message de Dranreb...histoire de Shape ! j'ai cafouillé dans les codes , les images, c'est un souk total ... lol

 

[patricktoulon]

re
le message de @Dranreb set clair
tes cartes sont des shapes groupées
quand tu clique dessus tu clique sur la shapes (nom du groupe)
pour modifier il te faut avoir acces au subshapes qui compose ce groupe(cette carte)

for each shap in shapes(nomdugroup).GroupItems
'là oui tu va lister les depts
next

 

[Dorileo]

re
Je comprends à 50% ton explication, ce qui est tout à fait logique...

Dans toutes mes lignes de codes, où dois-je placer
for each shap in shapes(nomdugroup).GroupItems
'là oui tu va lister les depts
next

Mon code pour la carte Groupe 2 qui est lié au bouton PAC5...je ne vois pas où placer ta ligne ? dans Sub ListShapes() ...

Sub EcritNoDepart()
For Each c In [départ]
If c <> "" Then ecritShape "fr-" & c, c.Offset(, 2) & Chr(10) & c
Next c
c = "54": ecritShape "fr-" & c, "Meurthe-" & Chr(10) & "Moselle", "Bas"
c = "90": ecritShape "fr-" & c, "TB"
c = "192": ecritShape "fr-" & c, "Hauts-Seine", , "Gauche"
c = "175": ecritShape "fr-" & c, "Paris"
c = "193": ecritShape "fr-" & c, "Seine-st-Denis"
c = "194": ecritShape "fr-" & c, "Val de Marne"
End Sub
--------
Sub coloriage2()
'PAC5
For Each c In [départ]
If c <> "" Then
ca = c.Offset(, 2)
p = Application.Match(ca, [légende], 0)
If Not IsError(p) Then
couleur = Range("légende").Cells(p, 1).Interior.Color
ActiveSheet.Shapes("fr-" & c).Fill.ForeColor.RGB = couleur
End If
End If
Next c
End Sub
----------
Sub ecritShape(nomShape, Libellé, Optional posVert, Optional posHoriz)
Application.Volatile
With ActiveSheet.Shapes(nomShape).TextFrame2.TextRange
.Characters.Text = Libellé
.Characters.Font.Size = 6
If IsMissing(posVert) Then
.Parent.VerticalAnchor = msoAnchorMiddle
Else
If posVert = "Bas" Then
.Parent.VerticalAnchor = msoAnchorBottom
Else
.Parent.VerticalAnchor = msoAnchorMiddle
End If
End If
If IsMissing(posHoriz) Then
.Parent.HorizontalAnchor = msoAnchorCenter
Else
If posHoriz = "Gauche" Then
.Parent.HorizontalAnchor = msoAnchorNone
Else
.Parent.HorizontalAnchor = msoAnchorCenter
End If
End If
End With
End Sub
-----------
Sub bulles2()
For Each s In ActiveSheet.Shapes
If s.Type <> 8 Then
ActiveSheet.Hyperlinks.Add Anchor:=s, Address:="", SubAddress:=""
tmp = Mid(s.Name, 2)
bulle = Application.VLookup(tmp, [departca], 2, False)
If Not IsError(bulle) Then
libdep = Application.VLookup(tmp, [departca], 3, False)
s.Hyperlink.ScreenTip = libdep & " Ca:" & Format(bulle, "# ##0") & Chr(10)
Else
s.Hyperlink.ScreenTip = "...."
End If
End If
Next s
End Sub
----------
Sub auto()
Application.Calculation = xlAutomatic
End Sub
----------
Sub manuel()
Application.Calculation = xlManual
End Sub
----------
Sub majPAC5()
coloriage2
bulles2
End Sub
----------
Sub ListShapes()
i = 2
For Each s In ActiveSheet.Shapes
Cells(i, "u") = s.Name
i = i + 1
Next s
End Sub

Merci pour vos lumières ...