XL 2010 Afficher plusieurs valeurs sur une carte

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

  • Essai.xlsm
    166.6 KB · Affichages: 49

grisouille

XLDnaute Nouveau
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
 

DelphineForm

XLDnaute Nouveau
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
 

Discussions similaires

Réponses
29
Affichages
1 K

Statistiques des forums

Discussions
311 716
Messages
2 081 848
Membres
101 826
dernier inscrit
dododu89