XL 2010 Afficher plusieurs valeurs sur une carte

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

grisouille

XLDnaute Nouveau
Bonjour à tous,

Sur une carte de France représentant les départements, j'affiche une valeur sur un fond en couleur suivant ce nombre.
Je voudrai en plus afficher le nom du département correspondant en complétant la macro.
Je n'arrive pas à combiner les deux.
Merci d'avance pour votre aide.
 

Pièces jointes

Bonjour,

Sur l'exemple, on peut choisir la position d'écriture.



Code:
Sub EcritNomDepart()
  For Each c In [départ]
  If c <> "" Then ecritShape "fr-" & c, c.Offset(, 2) & Chr(10) & c
  Next c
  c = "54": ecritShape "fr-" & c, "Meurthe-" & Chr(10) & "Moselle", "Bas"
  c = "90": ecritShape "fr-" & c, "TB"
  c = "192": ecritShape "fr-" & c, "Hauts-Seine", , "Gauche"
  c = "175": ecritShape "fr-" & c, "Paris"
  c = "193": ecritShape "fr-" & c, "Seine-st-Denis"
  c = "194": ecritShape "fr-" & c, "Val de Marne"
End Sub
 
Sub ecritShape(nomShape, Libellé, Optional posVert, Optional posHoriz)
    Application.Volatile
    With ActiveSheet.Shapes(nomShape).TextFrame2.TextRange
        .Characters.Text = Libellé
        .Characters.Font.Size = 6
        If IsMissing(posVert) Then
          .Parent.VerticalAnchor = msoAnchorMiddle
        Else
          If posVert = "Bas" Then
           .Parent.VerticalAnchor = msoAnchorBottom
          Else
           .Parent.VerticalAnchor = msoAnchorMiddle
          End If
        End If
        If IsMissing(posHoriz) Then
          .Parent.HorizontalAnchor = msoAnchorCenter
        Else
          If posHoriz = "Gauche" Then
           .Parent.HorizontalAnchor = msoAnchorNone
          Else
           .Parent.HorizontalAnchor = msoAnchorCenter
          End If
        End If
     End With
End Sub

BISSON
 
Bonjour,

Sur l'exemple, on peut choisir la position d'écriture.



Code:
Sub EcritNomDepart()
  For Each c In [départ]
  If c <> "" Then ecritShape "fr-" & c, c.Offset(, 2) & Chr(10) & c
  Next c
  c = "54": ecritShape "fr-" & c, "Meurthe-" & Chr(10) & "Moselle", "Bas"
  c = "90": ecritShape "fr-" & c, "TB"
  c = "192": ecritShape "fr-" & c, "Hauts-Seine", , "Gauche"
  c = "175": ecritShape "fr-" & c, "Paris"
  c = "193": ecritShape "fr-" & c, "Seine-st-Denis"
  c = "194": ecritShape "fr-" & c, "Val de Marne"
End Sub

Sub ecritShape(nomShape, Libellé, Optional posVert, Optional posHoriz)
    Application.Volatile
    With ActiveSheet.Shapes(nomShape).TextFrame2.TextRange
        .Characters.Text = Libellé
        .Characters.Font.Size = 6
        If IsMissing(posVert) Then
          .Parent.VerticalAnchor = msoAnchorMiddle
        Else
          If posVert = "Bas" Then
           .Parent.VerticalAnchor = msoAnchorBottom
          Else
           .Parent.VerticalAnchor = msoAnchorMiddle
          End If
        End If
        If IsMissing(posHoriz) Then
          .Parent.HorizontalAnchor = msoAnchorCenter
        Else
          If posHoriz = "Gauche" Then
           .Parent.HorizontalAnchor = msoAnchorNone
          Else
           .Parent.HorizontalAnchor = msoAnchorCenter
          End If
        End If
     End With
End Sub

BISSON
Bonjour,

Sur l'exemple, on peut choisir la position d'écriture.



Code:
Sub EcritNomDepart()
  For Each c In [départ]
  If c <> "" Then ecritShape "fr-" & c, c.Offset(, 2) & Chr(10) & c
  Next c
  c = "54": ecritShape "fr-" & c, "Meurthe-" & Chr(10) & "Moselle", "Bas"
  c = "90": ecritShape "fr-" & c, "TB"
  c = "192": ecritShape "fr-" & c, "Hauts-Seine", , "Gauche"
  c = "175": ecritShape "fr-" & c, "Paris"
  c = "193": ecritShape "fr-" & c, "Seine-st-Denis"
  c = "194": ecritShape "fr-" & c, "Val de Marne"
End Sub

Sub ecritShape(nomShape, Libellé, Optional posVert, Optional posHoriz)
    Application.Volatile
    With ActiveSheet.Shapes(nomShape).TextFrame2.TextRange
        .Characters.Text = Libellé
        .Characters.Font.Size = 6
        If IsMissing(posVert) Then
          .Parent.VerticalAnchor = msoAnchorMiddle
        Else
          If posVert = "Bas" Then
           .Parent.VerticalAnchor = msoAnchorBottom
          Else
           .Parent.VerticalAnchor = msoAnchorMiddle
          End If
        End If
        If IsMissing(posHoriz) Then
          .Parent.HorizontalAnchor = msoAnchorCenter
        Else
          If posHoriz = "Gauche" Then
           .Parent.HorizontalAnchor = msoAnchorNone
          Else
           .Parent.HorizontalAnchor = msoAnchorCenter
          End If
        End If
     End With
End Sub

BISSON
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
15
Affichages
4 K
Retour