Afficher une couleur sur un département avec une combobox

ok

Mais le fichier est très gros un peu plus 3Mo, j'ai dû réduire pour te l'envoyer

Comment fait-on pour mettre un fichier de plus de 3Mo?

j'ai essayé avec C.joint mais c'est refusé

J'ai rajouté une sécurité car si on fait [entrer] au lieu de cliquer ça plante (mais pas trop sûr de moi)

dans Public sub France

On Error GoTo fin '--------si erreur MsgBox----
....

fin:
     If Err.Number <> 0 Then MsgBox "Erreur " & Err.Number & vbLf & Err.Description & Chr(13) & _
     " Vous devez choisir dans la liste ( " & Chr(118) & " ) et cliquer sur " & Chr(13) & Chr(10) & "''" & _
     "Vous pouvez changer d'avis" & "''": Range("A1") = 0: Unload UserForm2: Call ColorierDepts2

J'ai mis un moment pour trouver

Mais quand j'apprécie le travail effectué, alors je cherche, et farfouille

bon parfois j'ai un gros plantage

il me reste quelques détails et il sera au top

Juste avant que tu me donne cet excellent fichier , j'étais entrain de supprimer 34300 villes pour ne laisser que les villes affichées sur la carte.

Mais vu le travail que tu m'as fait, je les ai remis

Merci pour tout

Bonsoir X Cellus

Voici le fichier complet

J'espère que je n'ai pas fait de bêtise dans tes codes

Bonne soirée

Ge0ffroy

Bonjour X Cellus,

Comment faire pour mettre une sécurité pour le code postale, s'il n'est pas dans la liste par exemple?

j'ai mis ça

On Error GoTo fin 
....
fin:
If Err.Number <> 0 Then MsgBox "Erreur " & Chr(13) & Chr(13) & " Ou ce N° " & ChxDpt & " ne se trouve pas dans la liste" 

Merci

@ bientôt

Bonsoir Ge0ffroy,

Ton dernier fichier ne comportait qu'un lien vers un site qui n'est pas accepté par mon logiciel de sécurité.

Donc j'ai repris l'avant dernier fichier réalisé et que tu trouveras modifié pour répondre à tes récentes remarques.

Soit l'indication sur la carte de la ville choisie avec le textbox. Voir notes en rouge sur le 1ier onglet.

Prendre Abbeville pour tester mais pour ton fichier complet la macro NomVille utilise la colonne A de la feuille Ville.

Un label a été ajouté en fin de formulaire et sert à lancer un lien hypertexte vers le site spécialisé (testé avec Abbeville).

Tout en contrôlant qu'il existe bien un lien dans la cellule cible.

Bonne application sur le fichier complet.

Bonjour X Cellus,

Merci beaucoup, je réponds de mon tel.

Je vais regarder ça et te tiens au courant.

Sympa 👍

Par contre c'est quel lien qui bloque?

Pour le supprimer de mon fichier.

Merci

Bonne semaine

Ge0ffroy

C'est du grand ART que tu m'as fait

Respect

J'ai ajouté une sécurité,

Sub NomVille()

'Affiche la ville sélectionnée
 On Error GoTo fin '--------si erreur MsgBox----

ActiveSheet.Shapes("Légende").Visible = True
nomV = VBA.Split(Range("N1"), " ")
ActiveSheet.Shapes("Légende").Top = ActiveSheet.Shapes(nomV(0)).Top - 1
ActiveSheet.Shapes("Légende").Left = ActiveSheet.Shapes(nomV(0)).Left + 35
ActiveSheet.Shapes("Légende").TextFrame2.TextRange.Characters.Text = nomV(0)
fin:
 If Err.Number <> 0 Then MsgBox "Erreur " & Err.Number & vbLf & Err.Description & Chr(13) & Chr(13) _
 & nomV(0) & Chr(13) & Chr(13) & " n'est pas encore sur cette carte  ": ActiveSheet.Shapes("Légende").Visible = False

End Sub

Cela fonctionne , ça efface bien la dernière 'légende"

Merci beaucoup, j'avais trouvé des codes pour extraire le lien mais ton dernier fichier est trop bien

Bravo!

@ bientôt

Ge0ffroy

Bonsoir X Cellus,

Tout en contrôlant qu'il existe bien un lien dans la cellule cible.

Tu as raison sur 34840 cellules j'en ai 4148 sans lien.

J'ai pu vérifier en lançant la macro d'extration et trier par lien.

Plus qu'à retrousser les manches et insérer ces manquants.

Par moment j'ai la ligne A1 de la feuille (Ville) qui se met à 0 ce qui provoque un plantage.

Je pense préciser la feuille pour cette ligne :

Range("A1") = 0 -->  sheets("Répartition").Range("A1") = 0

Je suis dans le bon ou pas?

Encore une fois tu as fait du bon boulot.

merci

Bonsoir Ge0ffrroy,

C'est cela en effet. A1 passe à 0 seulement pour la feuille Répartition. Le plus souvent cette feuille comportant la carte est toujours affichée. Suite au maniement du formulaire. Mais si tu cibles une autre feuille entre-temps la cellule A1 de cette feuille risque donc d'être nulle.

En précisant la feuille Répartition c'est plus sûr.

Bonjour X Cellus,

Je n'ai pas trouvé comment tu as fait pour lire ce lien sans l'extraire. J'ai une petite idée avec la ligne (. Tag) mais pas sûr.

Une petite question juste par curiosité.

Peut-on faire le contraire ?

Supposons que j'ajoute un bouton modifier. Je modifie la cellule Ax et j'ajoute le lien dans une textbox par exemple.

On aura la cellule Ax avec le nom de la ville et le lien correspondant.

Merci 🙏

@bientôt

Geoffroy

Bonsoir X Cellus,

La ville ne doit pas comporter d'espace, si non la légende ne reconnais pas la ville.

Exemple: "La Flèche" seulement "La" est mémorisé.

Peut-on y remédier ? ou je dois ajouter un "-" à la place des espaces dans chaque ville ?

Parfois la légende est légèrement décaler sur certaines villes voir image

Peut-on aussi y remédier?

merci

Ge0ffroy

Bonsoir X Cellus,

Peut-on dissosier le cadre du trait de la légende?

et comment avoir toute la cellule avec le CP entre parenthèse, pour la légende, car j'ai beaucoup de villes semblables?

Castres ---> Castres (80100), Castres (02680)-- Bonneville (74130), Bonneville (80670)...

J'ai trouvé

nomV = VBA.Split(Range("N1"), ")")

Naturellement je dois aussi l'ajouter sur la carte

résultat : Bonneville (80670

Sans le ' ) " à la fin mais c'est bon

merci

Bonjour Ge0ffroy,

Pour ta dernière remarque, si tu souhaites que le code postal s'affiche, prends alors directement la cellule N1. Donc sans passer par Split.

Tu auras bien les deux parenthèses encadrant le code postal.

Suite,

Il existe plusieurs formes de légende. J'ai utilisé la plus commune. A toi de voir par essai, celle qui te convient le mieux.

Pour le décalage, il semblerait que les départements les plus au nord soient concernés.

Même si celui est minime... Je regarderais en fin de semaine. Pour appliquer un correctif aux formes les plus hautes à l'écran.

Bonjour X Cellus,

Merci pour ton aide, c'est très sympa.

Mais je n'ai pas compris où on récupère les légende??🤔🤔

J'ai remarqué qu'on ne pouvait pas dissocier le trait du cadre.

Oui tu as entièrement raison pour ce petit décalage qui est très minime mais c'est mon côté perfectionniste et j'aime bien connaître les raisons. 😉

J'essaye de "décortiquer" tes codes mais vu que c'est tout nouveau pour moi 🤔🤕🧐😥

Vu que je n'ai toujours pas compris comment tu as fait pour lire le lien sans l'extraire ?? 🤔🤔🤕

Bonne journée

@bientôt

Ge0ffroy

Bonjour,

 ....prends alors directement la cellule N1. Donc sans passer par Split.

c'est bien cette ligne: nomV = VBA.Split(Range("N1"), " ")

j'ai mis ceci à la place : nomV = Range("N1")

ça plante à cette ligne :

ActiveSheet.Shapes("Légende").Top = ActiveSheet.Shapes(nomV(0)).Top - 1

pas tout compris, désolé

Pour le positionnement ne te tracasses pas, j'ai changé de légende et mis un repère

J'ai retiré le nom encadré car on l'a déjà sur le doigt de la souris.

merci

Bonne soirée

Bonjour X Cellus,

Voici le fichier avec 332 villes avec celles affichées sur l'écran, quelques une sans lien, même nom:

J'ai commencé à ajouter une inputBox pour ajouter les lien inexistants mais pas pu allé plus loin dans mes démarches

merci

@bientôt

Geoffroy

Bonjour Ge0ffroy,

J'aurais dû préciser. Il faut aussi changer sur

ActiveSheet.shape(NomV(0)) =- 1
'par
ActiveSheet.Shape(NomV) = - 1
' vu que la donnée n'a pas été scindée en deux.
'Le (0) précisant la première partie, donc la ville
' Le (1) ressortant le code postal

'Cela te permet de faire des tests pour une prochaine fois utiliser Split

Bonsoir X Cellus,

merci

OK ça fonctionne

je n'ai plus qu'à changer les formes

'Cela te permet de faire des tests pour une prochaine fois utiliser Split

oui , je me suis déjà fait plaisir , je ne peux pas m'empêcher de faire des tests.

Excellent , merci beaucoup

bonne soirée

@bientôt

Ge0ffroy

Bonsoir X Cellus,

Je viens d'utiliser ton code 'split' pour les noms de villes sans lien:

Sub chercherLien()
    Dim wikip As String
    Dim ligE As Long
      Application.ScreenUpdating = False
  For i = 2 To 4149
    Range("A" & i).Select
    nom = VBA.Split(Range("A" & i), " ")
    wikip = "https://www.site.org/wiki/"
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=wikip & nom(0), TextToDisplay:=nom(0) & " " & nom(1)
       Next i
End Sub

Du coup j'ai tous les liens à part ces 3, impossible d'insérer un lien, même en manuelle. Pas compris pourquoi?

Zutkerque (62370)
Zuydcoote (59123)
Zuytpeene (59670)

Merci pour tout

J'essaye d'ajouter un bouton Ajout/modification des villes ?

Bonne soirée

Bonsoir X Cellus

J'ai pu insérer le lien pour ces 3 villes mais il n'est pas reconnu avec ton code:

affiche: "il n'y a pas de lien hypertexte dans la cellule " :

Si tu as une idée?

Désolé, c'est ma faute

(CelLien.Address) .

C'est grace à ce dernier code que j'ai pu voir qu'il y avait un doublon

Bon dimanche

Ge0ffroy