XL 2010 Afficher plusieurs valeurs sur une carte

grisouille · 1 Juillet 2017

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 · 1 Juillet 2017

Bonjour grisouille

Vois si cela te convient

grisouille · 1 Juillet 2017

Bonjour pierrejean,

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

grisouille · 3 Juillet 2017

BISSON Nicole à dit:

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

grisouille · 3 Juillet 2017

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 · 3 Juillet 2017

BISSON Nicole à dit:
Bonjour,

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

BISSON

grisouille · 3 Juillet 2017

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 · 16 Janvier 2018

BISSON Nicole à dit:

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

BISSON Nicole à dit:

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 · 16 Janvier 2018

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

XL 2010 Afficher plusieurs valeurs sur une carte

grisouille

XLDnaute Nouveau

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

grisouille

XLDnaute Nouveau

grisouille

XLDnaute Nouveau

grisouille

XLDnaute Nouveau

grisouille

XLDnaute Nouveau

grisouille

XLDnaute Nouveau

DelphineForm

XLDnaute Nouveau

DelphineForm

XLDnaute Nouveau

Discussions similaires

XL 2010 Afficher plusieurs valeurs sur une carte

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency