Comment appliquer une macro à un groupe de Labels avec Label_MouseMove ?

Bonjour à tous,

Pour le travail je cherche à créer une carte interactive de la France avec des données par département qui s'affichent dans un rectangle à côté, au survol de chaque département.

Private Sub Label01_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim nomDept As String ' Nom du département
Dim lLine As Long ' Numéro de ligne
Dim valDept As Integer ' Volume du département
Dim dept As Integer ' Numéro du département
Dim layerDept As Long ' Label sur la forme du département
Dim oSheet1 As Excel.Worksheet ' Feuille 1
Dim oSheet2 As Excel.Worksheet ' Feuille 2
Dim valDelais As Integer ' Délai du département
Dim valCout As Integer ' Coût du département
Dim nomRegion As String ' Nom de la région liée au département

Set oSheet2 = ThisWorkbook.Sheets("TCD2")
Set oSheet1 = ThisWorkbook.Sheets("VolumesExperts")

dept = 1

' Une fonction "recherchev" qui va récupéré les volumes du département dans le TCD2
valDept = Application.WorksheetFunction.VLookup(dept, oSheet2.Range("A1:B96"), 2, False)
' Une fonction "recherchev" qui va récupéré le nom du département dans le TCD2
nomDept = Application.WorksheetFunction.VLookup(dept, oSheet2.Range("I1:L95"), 2, False)
' Une fonction "recherchev" qui va récupéré le délai moyen du département dans le TCD2
valDelais = Application.WorksheetFunction.VLookup(dept, oSheet2.Range("A1:C95"), 3, False)
' Une fonction "recherchev" qui va récupéré le cout moyen du département dans le TCD2
valCout = Application.WorksheetFunction.VLookup(dept, oSheet2.Range("A1:D95"), 4, False)
' Une fonction "recherchev" qui va récupéré le nom de la région dans le TCD2
nomRegion = Application.WorksheetFunction.VLookup(dept, oSheet2.Range("I1:L95"), 4, False)
' Affichage dans le rectangle prévu à cet effet, des informations récupérées
oSheet1.Shapes("Valeurs").TextFrame.Characters.Text = nomRegion & Chr(13) & Chr(10) & dept & " - " & nomDept & " : " & valDept & " missions" & Chr(13) & Chr(10) & "Délai moyen : " & valDelais & " jours" & Chr(13) & Chr(10) & "Coût moyen : " & valCout & "€"

End Sub

J'ai fais la macro suivante, cependant, je suis contraint de l'affecter au Label visé par le survol et donc de dupliquer 95 fois la macro en changeant la variable dept à chaque fois.

Est-il possible d'appliquer une boucle pour tout regrouper en une seule macro ?

Je suis navré, la politique sécurité de mon entreprise m'interdit la transmission de tout fichier, même anonymisé ou simplifié.

image

Bonsoir Fanfounator,

Je suppose que ta feuille listant les départements classent ceux-ci par leur numéro.

Tu n'as donc besoin que d'un VLookup. Celui du département, une fois ce dernier trouvé. Les autres informations doivent normalement être classées sur la même ligne que le département ciblé. Donc des offset(Ligne, Colonne) sur la cellule de ce département te donneront les autres valeurs.

' Une fonction "recherchev" qui va récupéré le nom du département dans le TCD2
nomDept = Application.WorksheetFunction.VLookup(dept, oSheet2.Range("I1:L95"), 2, False)

Apparemment tu as inséré 95 labels Labelxx_Mouse_Move dans ton code. Donc je vais rester sur ce schéma.

Mais saches que l'on peut créer un Module de Classe capable (avec un code minimal) de gérer tous les labels. Comme s'il ne faisait qu'un seul.

Dans le classeur ci-dessous, un exemple (avec 4 labels) pour ton schéma initial. Il suffit d'appliquer le principe au tiens.

Une macro va regrouper le traitement affichage des données. La variable étant le numéro du département et dans ton cas la ligne pour lui où sont ces infos.

Chaque label envoyant à cette macro son caption ou son tag qui est le N° départemental.

Et cette macro réceptrice comprendra donc tous les DIM, les 2 oSheet puis un seul VLookup pour cibler la ligne du département.

12fanfounator.xlsm (25.14 Ko)

Fais un survol sur chacun des 4 labels et vois le changement en cellule A1.

Rechercher des sujets similaires à "comment appliquer macro groupe labels label mousemove"