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]

Avant de pouvoir accéder à un département il faut d'abord isoler la carte concernée, qui est un Shape de type Groupe.
Les deux du classeur joint s'appellent "Groupe 1" et "Groupe 2" Mais peut être vaudrait-il mieux les nommer "CartePAC4" et "CartePAC5" comme ça vous pouvez formez leurs noms par concaténation. Une fois que vous avez fait ce Set ShpCarte = ActveSheet.Shapes("Carte" & LeTitreDeLaColonne), accédez aux départements par sa collection GroupItems
Avec ActiveSheet.Shapes("fr-" & c).Fill.ForeColor.RGB = couleur il colore le premier venu qui porte ce nom dans n'importe quelle carte, on dirait.
Avec ShpCarte.GroupItems("fr-" & c).Fill.ForeColor.RGB = couleur c'est sûr qu'il va colorer celui de la bonne carte.

 

[Dorileo]

Je comprends mieux la fonction Shape de type Groupe.
Donc ce qu vous me précisez ci dessus porte une modification sur les 2 méthodes ci-dessous.
J'ai bien ciblé celle qui est en gras ci-dessous que vous m'avez gentiment partagé.
Mais concernant la ligne "ShpCarte.GroupItems("fr-" & c).Fill.ForeColor.RGB = couleur" je la remplace par celle qui est en bleu ci-dessous ou dois-je la caler en supplément dans ces lignes de code ?

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("Carte" & PAC5).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

 

[Dranreb]

Non c'est dans la Sub Coloriage que vous vous pouvez mettre With ActiveSheet.Shapes("CartePAC5") au début si vous voulez et a l'intérieur vous remplacez ActiveSheet.Shapes par .GroupItems
Si toutefois "CartePAC5" est bien le nom du groupe contenant la carte et non pas celui du label !
Vous pourriez ne faire qu'une seule Sub de coloriage à laquelle vous transmettriez ce groupe en argument.

 

[Dorileo]

CartePAC5 est bien que j'ai donné à la carte, je confirme
J'ai mis le code ainsi, en ajoutant With ActiveSheet.Shapes("CartePAC5") j'ai ajouté End With en fin, il le réclamait.
Mais j'ai un code d'exécution 438 avec ActiveSheet.GroupItems

Sub coloriage2()
'PAC5
With ActiveSheet.Shapes("CartePAC5")
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.GroupItems("fr-" & c).Fill.ForeColor.RGB = couleur
End If
End If
Next c
End With
End Sub

 

[Dranreb]

Non ! La collection GroupItems n'est pas une propriété d'objet Worksheet, c'est une propriété d'objet Shape quand il est de type Groupe. Donc enlevez ActiveSheet, laissez juste le point pour qu'il assume l'objet indiqué à l'instruction With.

 

[Dorileo]

Rien ne fonctionne
j'ai beau y tourner dans tous les sens....le bouton 5 PAC5 agit toujours sur la carte PAC4...incroyable !
A rendre dingue ... ça doit tenir à pas grand chose ... la nuit va être longue, je dois présenter le fichier demain
Merci pour les tuyaux, vos conseils et le temps que vous avez accordé à mon attention, c'est vraiment sympa

 

[Dranreb]

C'est parce que vous appliquez toujours votre foutu Activesheet.Shapes au lieu de .GroupItems

Tâchez de tout faire dans un seul module avec des procédures courtes et paramétrées.

 

[Dorileo]

Oui .. foutu Activesheet.Shapes !!! qui l'a invité ?
Je vais continuer à fouiner sur des forums la clé de la solution.
Merci pour votre aide bien précieuse
Salutations

 

[Dranreb]

Vraiment, pour faciliter aussi bien le développement que la maintenance, tâchez d'organiser un peu tout ça dans un seul module, dans le genre :

Sub MaJPAC4()
  Coloriage ActiveSheet.Shapes("CartePAC4")
  bulles
  End Sub
Sub MaJPAC5()
  Coloriage ActiveSheet.Shapes("CartePAC5")
  bulles
  End Sub
Sub Coloriage(ByVal ShpCarte As Shape)
   If ShpCarte.Type <> msoGroup Then MsgBox """" & ShpCarte.Name & """ n'est pas un groupe", _
      vbExclamation, "Coloriage": Exit Sub
   For Each C In [départ]
      If C <> "" Then
         CA = C.Offset(, 1)
         P = Application.Match(CA, [légende], 0)
         If Not IsError(P) Then
            Couleur = Range("légende").Cells(P, 1).Interior.Color
            ShpCarte.GroupItems("FR-" & C).Fill.ForeColor.RGB = Couleur
            End If
      End If
      Next C
   End Sub

 

[Dorileo]

Woua ! d'ici que je t'atteigne votre savoir, je serai un druide à longue barbe blanche.
Il y a un résultat encouragent, je ne sais pas comment vous remercier !
Le bouton 5 colorise la CartePAC5 et aussi celle de PAC4 mais je pense deviner pourquoi.
Apparemment il boucle uniquement sur la colonne que l'on lui cible ...
Sur la ligne CA = C.Offset(, 1) si je mets 2, il lit la colonne 2 du tableau et colorise les 2 cartes à la fois.


Sub Coloriage(ByVal ShpCarte As Shape)
If ShpCarte.Type <> msoGroup Then MsgBox """" & ShpCarte.Name & """ n'est pas un groupe", _
vbExclamation, "Coloriage": Exit Sub
For Each C In [départ]
If C <> "" Then
CA = C.Offset(, 1)
P = Application.Match(CA, [légende], 0)
If Not IsError(P) Then
Couleur = Range("légende").Cells(P, 1).Interior.Color
ShpCarte.GroupItems("FR-" & C).Fill.ForeColor.RGB = Couleur
End If
End If
Next C
End Sub

 

[Dranreb]

Vous pouvez aussi ajouter d'autres paramètres, indiquant notamment avec quelle plage il doit travailler. Ou mieux leurs valeurs sous forme de tableaux. Je n'aime pas utiliser Cells ni Range dans des boucles, c'est lent, je préfère tout charger dans des tableaux et parcourir ceux ci.

 

[Dorileo]

Merci pour tout ce que vous faite à mon égard....c'est vraiment chouette !
Je vais étudier votre suggestion pour qu'il parcourt mon tableau et cible les bonnes données.