Carte département

Bonjour,

Dans cette solution, La valeur s'affiche dans le cercle (10*10)

Sub Placer_Chariots()
Dim derlig As Integer, lig As Integer
Dim longitude As Double, latitude As Double
Dim tablo() As String

Dim sh As Shape
Dim Sepa  As String

    For Each sh In Sheets("Carte").Shapes
        If (Left(sh.Name, 1) = "_") Then sh.Delete
    Next sh

    Sepa = "," 'Application.International(xlDecimalSeparator)
    derlig = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
    For lig = 2 To derlig
            Chariots = Sheets("Data").Cells(lig, "F").Value
            If Chariots > 0 Then
        tablo = Split(Sheets("Data").Cells(lig, "E").Value, ",")
        latitude = (latitude0 - CDbl(Replace(tablo(0), ".", Sepa))) * 535
        longitude = (longitude0 + CDbl(Replace(tablo(1), ".", Sepa))) * 350
        Set sh = Sheets("Carte").Shapes.AddShape(msoShapeOval, longitude, latitude, 10, 10)
        With sh
            .Name = "_" & Sheets("Data").Cells(lig, "B").Value
            .Fill.ForeColor.RGB = RGB(250, 0, 0)
            .Line.Weight = 1
            With .TextFrame2
                 .TextRange = Sheets("Data").Cells(lig, "F").Value
                 .TextRange.Font.Size = 8
                 .MarginLeft = 2.8346456693
                 .MarginRight = 0
                 .MarginTop = 0
                 .MarginBottom = 0
                 .VerticalAnchor = msoAnchorMiddle
                 .HorizontalAnchor = msoAnchorNone
            End With
           ' .OnAction = "USF"
        End With
        End If
    Next lig
    Sheets("Carte").Range("B1").Select

End Sub

Rebonjour,

Merci beaucoup c'est génial !

Je vois que la fonction =NB.SI(Liste!$B$2:$B$1300;B3) est utiliser pour calculer le nombre de fois ou la ville est dans la feuille liste.

Chaque ville corresponds à une couleur, il est possible pour une couleur de connaitre le décompte total?

Merci d'avance,

Bonjour, j'ai réussi à trouver ma précédente question, et aussi à créer un bouton supprimer.

Par contre je ne trouves pas comment mettre les chiffres globaux trouvé pour chaque couleur sur la carte, les données sont sur la feuille date en bas...

Une aide svp?

Merci d'avance,

Soit une zone nommée CouleursChoisies correspondant à l'aire K1:P1 dans l'onglet Data (manque la couleur verte).

Et un tableau structuré Tableau1 correspondant à la table dans Data.

Option Explicit

Sub DecompterParCouleurs()

Dim I As Integer, J As Integer, NbValeurs As Integer

Dim AireCouleurs As Range, AireCommunes As Range

    Set AireCouleurs = Range("CouleursChoisies")
    Set AireCommunes = Range("Tableau1[Commune]")

    AireCouleurs.ClearContents
    For I = 1 To AireCouleurs.Count
        NbValeurs = 0
        For J = 1 To AireCommunes.Count
            If AireCouleurs(I).Interior.Color = AireCommunes(J).Interior.Color Then
               NbValeurs = NbValeurs + 1
            End If
        Next J
        AireCouleurs(I) = NbValeurs
    Next I

End Sub