Coloriage de formes libres (shapes)
Bonjour l'équipe.
Je travaille avec excel 2007.
J'ai inséré une image .WMF (MAP de l'Algérie), renfermant plusieurs formes libres qui constitudent les différentes villes importantes du pays.
Code utilisé pour l'insertion de la MAP est le suivant :
fichier = ThisWorkbook.Path & "\algerie_fr49.WMF"
Set shp = ActiveSheet.Shapes.AddPicture(fichier, msoTrue, msoCTrue, 15, 62, 450, 450)
Par la suite j'ai dissocié toutes les formes que j' ai renommées puis stockées dans la colonne "J" de la même feuille et sur la colonne "O". Dans la colonne "K" de la même feuille, j'ai enregistré le code RGB qui servira au remplissage de la forme correspondante.
Mon problème réside à ce niveau, en voulant remplir chaque forme par la couleur RGB qui figure dans la colonne "P":
ActiveSheet.Shapes(sh.Name).Line.ForeColor.RGB =RANGE("P" & i).value ''ça ne fonctionne pas
Par contre, ça fonctionne en utilisant cette syntaxe:
ActiveSheet.Shapes(sh.Name).Line.ForeColor.RGB =RGB(255,0,0)
sh.name = Nom de la forme sur colonne "J".
J'espère être clair dans la description de mon problème, d'avance je vous remercie pour votre aide.
Said A.
bonjour
Sub colorer()
With Sheets("MACARTE_TT") 'la feuille
With .Range("J1:P59") 'plage avec les données
a = .Value 'matrice avec tout le contenu de la plage
col1 = .Columns(1).Value 'matrice avec uniquement la première colonne
End With
For Each shp In .Shapes 'boucle les shapes
r = Application.Match(shp.Name, col1, 0) 'recherchez le nom du shape dans la matrice Col1
If IsNumeric(r) Then 'trouvé !!!
sp = Split(Replace(Replace(Replace(a(r, 7), "(", ","), ")", ","), " ", ""), ",") 'remplacez le ( et ) par une virgule, effacez les espaces et diviser le résultat sur la virgule
If UBound(sp) = 4 Then shp.Fill.ForeColor.RGB = RGB(sp(1), sp(2), sp(3)) 'utilisez 3 éléments pour définir le coleur
Else
If Not shp.Name Like "Forme libre*" And Not shp.Name Like "Free*" Then s = s & vbLf & shp.Name 'tous les formes non-traités, sauf ceux qui commencent avec un tel nom
End If
Next
If Len(s) > 0 Then MsgBox s, vbInformation, UCase("Formes non colorés")
End With
End SubBonjour Monsieur.
Mes vifs remerciements et c'est ce que je cherchais vraiment.
Un peu plus avare de connaissances, pouvez vous aussi m'indiquer s'il est possible de colorier les contours de formes avec la même couleur?
Encore une fois, Merci d'avance et belle journée.
bonjour, chaque région semble être fait par 2 formes, un avec le nom dans la colonne J et un qui s'appele "Forme Libre xx". Maintenant cela dépend de ce que vous voulez faire avec ces bordures (les verts et les rouges). Donc vous avez le choix ... , .
Sub colorer()
With Sheets("MACARTE_TT") 'la feuille
With .Range("J1:P59") 'plage avec les données
a = .Value 'matrice avec tout le contenu de la plage
col1 = .Columns(1).Value 'matrice avec uniquement la première colonne
End With
For Each shp In .Shapes 'boucle les shapes
With shp
'*****************1ier sorte de shapes = ceux avec un nom dans la colonne J ************************************************************
r = Application.Match(.Name, col1, 0) 'recherchez le nom du shape dans la matrice Col1
If IsNumeric(r) Then 'trouvé !!!
sp = Split(Replace(Replace(Replace(a(r, 7), "(", ","), ")", ","), " ", ""), ",") 'remplacez le ( et ) par une virgule, effacez les espaces et diviser le résultat sur la virgule
If UBound(sp) = 4 Then
.Fill.ForeColor.RGB = RGB(sp(1), sp(2), sp(3)) 'utilisez 3 éléments pour définir le coleur
With .Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 255, 0) ' leur bordure est vert !!!
.Weight = 4 'epais !!!
.Transparency = 0.5
End With
End If
Else
'**************************2ième sorte de formes = ceux qui commencent avec Forme Libre ******************************************************
If .Name Like "Forme libre*" Then
With .Line
.Weight = 1.5
.ForeColor.RGB = RGB(255, 0, 0) ' RGB(sp(1), sp(2), sp(3)) ' RGB(255, 0, 255)
.Transparency = 0
End With
Else
'************************* les autres formes *********************************************************************
s = s & vbLf & shp.Name 'tous les formes non-traités, sauf ceux qui commencent avec un tel nom
End If
End If
End With
Next
If Len(s) > 0 Then MsgBox s, vbInformation, UCase("Formes non colorés")
End With
End Sub