Carte Dynamique VBA

Bonjour !

Je suis nouvelle sur le forum, et j'ai peu de connaissance sur VBA. Pour mon travail , je dois faire une carte avec les différentes régions de France. Je voudrais colorié la Carte selon 3 critère avec donc 3 dégradé de couleur différente.

J'ai voulu m'inspiré d'un code que j'ai trouvé sur un forum, mais cela ne fonctionne pas. Plus précisèmment , cela bug avec la formule Active.sheet.shape ("Departement"). Ce n'est ni le nom de la forme, ni le nom de la feuille. Est ce que cela fait appel à un "calque" ? Si c'est le cas comment je peux modifier le nom de ce calque ?

Si quelqu'un peut m'aider svp.

Merci !

Bonjour bougresse et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum

Pour ce qui est de votre demande, peut-être pouvez-vous vous inspirer du sujet suivant
https://forum.excel-pratique.com/excel/carte-de-france-interactive-t67236.html

Sinon sur Excel, on ne parle pas en "calque", "Departement" est le nom d'une forme "Shape" en VBA

Ne sachant pas ce que vous voulez obtenir exactement, je ne pourrais vous aider plus.

Merci de votre participation

Cordialement

Nota : ne faites pas de cross posting, il n'est pas toléré sur ce forum (ou indiquez le)

Merci pour le lien,

Oui en faite je cherche à colorier graduellement les régions selon 3 critères: CA, nb d'entreprise et Emplois.

Ci-dessous le fichier original sur lequel je me suis basé, c'est avec des départements ( et moi des régions) mais ma carte est sur le même principe.

Je n'arrive pas à trouver à quoi fait réference "departement" (dans le fichier original), ce n'est pas les départements, ni le nom de la carte.

Voir ci dessous en gras :

Sub ColorierCarte(PlageClasses As Range, PlageLegendes As Range)
'colorie chaque departement de la carte de France en fonction du critere specifie
'ENTREE PlageClasses : indique les valeurs des classes de chaque departement (95 cellules)
' PlageLegende : indique la legende (pour la couleur de fond de chaque cellule)
' (contient autant de cellules que de valeurs de classe)
Dim numDep As Integer, numClasse As Integer, couleurClasse As Long
Dim selectionInitiale As Range

'1.memorise la position de la cellule initialement sélectionnée
Set selectionInitiale = ActiveCell
'2.colorie chaque département
For numDep = 1 To PlageClasses.Rows.Count
numClasse = PlageClasses.Cells(numDep, 1)
couleurClasse = PlageLegendes.Cells(numClasse).Interior.Color
ActiveSheet.Shapes("Departement " & Format(numDep, "00")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = couleurClasse
Next numDep
'3.restaure la position de la cellule ou plage initialement sélectionnée
selectionInitiale.Select
'4.recopie les couleurs des classes de légende
CopierCouleurFond PlageLegendes, [LegendeCarte]
End Sub

Ps: c'est quoi le cross posting ?

Merci !

Entre temps j'ai résolu ce problème. Mais un autre est apparu , Tout est ok sauf que le carte ne se colorie pas en fonction des différents légendes, j'ai pourtant bien indiqué la Shape. Je ne comprends pas d'où vient le problème.

Bonjour à tous,

Voici une proposition (basée sur une de mes cartes)

Le code est simplex :

Sub Coloration(cat As String)
Dim T As Variant, idx As Byte, i As Byte, clr As Long

    idx = Application.Match(cat, Array("Lauréats TTE", "Emplois", "Montant"), 0)
    T = Sheets("Region").Range("B1:H32")
    For i = 11 To 32
        clr = Sheets("Region").Cells(T(i, 1 + (idx * 2)) + 1, 1 + (idx * 2)).Interior.Color
        Sheets("Carte").Shapes(T(i, 1)).Fill.ForeColor.RGB = clr
    Next i
End Sub

Juste un détail : ici il s'agit des anciennes régions de France.

Pierre

Merci beaucoup Pierrep56 !

Ton fichier m'a beaucoup aidé et j'ai pu l'adapté aux nouvelles régions !

Juste une petit détail: la coloration de la carte s'arrête a la classe 4, Toutes les valeur au dessus sont comprise dans cette classe.

Le rouge, bleue et vert foncé n'apparaissent donc pas dans la carte . Et je ne trouve pas pourquoi ?

Merci pour ton aide

Bonjour,

En effet, erreur de ma part, il fallait écrire :

Sub Coloration(cat As String)
Dim T As Variant, idx As Byte, i As Byte, clr As Long

    idx = 1 + (Application.Match(cat, Array("Lauréats TTE", "Emplois", "Montant"), 0) * 2)
    T = Sheets("Region").Range("B1:H32")
    For i = 11 To 32
        clr = Sheets("Region").Cells(T(i, idx) + 2, idx).Interior.Color
        Sheets("Carte").Shapes(T(i, 1)).Fill.ForeColor.RGB = clr
    Next i
End Sub

(j'aurai voulu aller trop vite sans bien vérifier, probablement)

Pierre

Merci beaucoup pour ton aide !

Bonnes fêtes ! :)