Inscrire une valeur sur une carte

grisouille

XLDnaute Nouveau
Bonjour à tous

N'ayant pas beaucoup de connaissance en VBA, je viens vers vous pour trouver une solution à mon problème.

Pour ma généalogie j'ai un fichier avec un onglet "Carte" en l'occurrence le département 76, un onglet "Légende" et un dernier "Communes".

Je voudrais faire apparaître en plus sur la carte le nb d'ancêtres correspondant à la ville mentionnée sur l'onglet "Communes" avec la macro "Actualiser".

Actuellement cette macro développée par un site où l'on télécharge le fichier, colore en fonction du nb d' ancêtres les villes concernées.

J'ai séparé mon fichier en 2 (taille du fichier trop grande).Mais en réalité les 3 onglets sont sur le même fichier.
Je m'aperçois que même en compressant le fichier "Carte D76" il est < à la limite (306ko).
Comment puis je le joindre ?
Je mets uniquement le fichier comprenant la macro.
Ce n'est peut-être pas assez explicite pour trouver la solution.

Merci d'avance pour votre aide.
 

Pièces jointes

  • Essai D76 v1 .xlsm
    55.5 KB · Affichages: 54
  • Essai D76 v1 .xlsm
    55.5 KB · Affichages: 50

gosselien

XLDnaute Barbatruc
Re : Inscrire une valeur sur une carte

Bonjour,

j'ai fais un truc du genre il y a peu avec l'aide de JB présent souvent ic i:)
je te mets en attaché mais ça concerne une région de belgique et spécifiquement le hainaut où nous avons moins de communes/villes/villages que chez vous :)

les cartes viennent de d-maps.com : free maps, free blank maps, free outline maps, free base maps

P.
 

Pièces jointes

  • exemple carte.xlsm
    238.8 KB · Affichages: 86

grisouille

XLDnaute Nouveau
Re : Inscrire une valeur sur une carte

Bonjour,

Décidément je n'y arrive pas même avec les conseils de Gosselien et Tatiak.

Actuellement j'utilise cette macro

Public Sub Actualiser()

Dim Var As Integer 'variable de boucle
Dim IDCommune As String 'variable contenant ID commune
Dim NOMCommune As String 'variable contenant le nom de la commune
Dim nbDonnees As Integer
Dim AddCouleur As Integer
Dim LaCouleur As Long
Dim DerLig As Long, Lig As Long, FlgStatB As Boolean
Dim ShtCou As Worksheet, ShtCmm As Worksheet

' Mémorise si la barre de statut est affichée ou non
FlgStatB = Application.DisplayStatusBar
' Afficher la barre de statut
Application.DisplayStatusBar = True

'Coloriage de la carte
'=====================
' Définir chaque feuille
Set ShtCmm = Sheets("Communes")
Set ShtCou = Sheets("Legende")

' Avec la feuille CARTE
With Sheets("Carte")
.Activate
' Pour chaque commune
For Var = 3 To 747
' Récupérer le nom de la zone de la feuille : ShtCmm = communes
IDCommune = ShtCmm.Range("A" & Var).Value
NOMCommune = ShtCmm.Range("B" & Var).Value
' Afficher la progression
Application.StatusBar = "Traitement : " & NOMCommune
' Récupérer le nombre de donnees dans cette zone
nbDonnees = ShtCmm.Range("E" & Var).Value
' Pour éviter les erreurs si le nombre n'est pas trouvé
On Error Resume Next
Lig = 0
' Recherche dans la feuille couleur, la ligne correspondant au nombre de donnees

' Récupère le numéro de couleur correspondant à la ligne
AddCouleur = ShtCmm.Range("F" & Var).Value

'selection de la zone sur la carte
LaCouleur = ShtCou.Range("couleur" & AddCouleur).Interior.Color
.Shapes("com_" & IDCommune).Select
'attribution d'une couleur'
Selection.ShapeRange.Fill.ForeColor.RGB = LaCouleur
' Selection.ShapeRange.Fill.ForeColor.SchemeColor = AddCouleur
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid

' Attribution d'un commentaire
' .Hyperlinks.Add Anchor:=.Shapes("_" & IDCommune), _
' Address:="#", _
' ScreenTip:="" & NOMCommune & ""
Next Var
.Range("J1").Select
End With
Application.StatusBar = ""
Application.DisplayStatusBar = FlgStatB
' Vider les variables objet
Set ShtCmm = Nothing
Set ShtCou = Nothing
End Sub

Cette macro permet de visualiser le nom des villes et de colorier ces dernières en fonction du nb d'ancêtres.
Je voudrais insérer quelques lignes me permettant de faire apparaître en plus le nb d'ancêtres.
Où doit-on les insérer et comment l'écrire.
Le fichier "Carte D76" (306ko) étant > à la limite même en le compressant, je ne sais pas le joindre.

Merci pour votre aide.
 

Discussions similaires

Réponses
29
Affichages
1 K
Réponses
31
Affichages
2 K