XL 2010 Afficher plusieurs valeurs sur une carte

[grisouille]

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.

 

[pierrejean]

Bonjour grisouille

Vois si cela te convient

 

[grisouille]

Bonjour pierrejean,

C'est tout à fait ce que je désirais.
Merci encore pour l'aide.

 

[grisouille]

Bonjour,

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

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

 

[grisouille]

Bonjour Nicole Bisson,

J'ai regardé votre solution, mais cela "bug" sur For Each c In [départ] dans mon exemple.
Comment intégrer cette macro dans le module.
Merci.

 

[grisouille]

Bonjour,

départ est un champ nommé (N2:N99).

BISSON

 

[grisouille]

A Nicole Bisson,

J'ai renommé le champ "Départ" (dans mon exemple B2:B97).
Maintenant la macro s'arrête sur: With ActiveSheet.Shapes(nomShape).TextFrame2.TextRange
Comment dois-je m'y prendre.

 

[DelphineForm]

Bonjour,

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

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.

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]

Bonjour,

Le fichier Copie de CarteFranceDepNom.xls me convient mais comme je ne fais plus de VBA, ce n'est pas évident de s'y remettre et je voudrais plutôt afficher les chiffres (CA)

D'avance merci