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 Sub

Bonjour 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
Rechercher des sujets similaires à "coloriage formes libres shapes"