Discussion :

[maxval18]

Bonjour,

J'ai une carte de France et lorsque je passe mon curseur sur une shape la région change de couleur . Lorsque je passe mon curseur sur une chape ex:
Bretagne un Label s'ouvre en haut et a droite de la feuille.
J'aimerai que sur se label qui s'ouvre on retrouve les données correspondant a la région qui se trouve sur l'onglet "Données"
Ci joint mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 If X < 10 Or X > Image1.Width - 10 Or Y < 10 Or Y > Image1.Height - 10 Then
   ActiveSheet.Shapes("Bretagne").Fill.ForeColor.RGB = RGB(255, 255, 255) 'Couleur de fond blanc
 
             ActiveSheet.Shapes("Label1").Fill.ForeColor.RGB = RGB(255, 255, 0) 'Couleur de fond jaune
             ActiveSheet.Shapes("Label1").Visible = False
              ActiveSheet.Shapes("Label_info1").Fill.ForeColor.RGB = RGB(102, 101, 255) 'Couleur de fond jaune
              ActiveSheet.Shapes("Label_info1").Visible = False
  Else
             ActiveSheet.Shapes("Label1").Visible = True
            ActiveSheet.Shapes("Label_info1").Visible = True
 
   ActiveSheet.Shapes("Bretagne").Fill.ForeColor.RGB = RGB(0, 255, 0) 'Couleur de fond vert
 End If
End Sub
 
 
Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 If X < 10 Or X > Image2.Width - 10 Or Y < 10 Or Y > Image2.Height - 10 Then
   ActiveSheet.Shapes("Basse-Normandie").Fill.ForeColor.RGB = RGB(255, 255, 255) 'Couleur de fond blanc
 
             ActiveSheet.Shapes("Label2").Fill.ForeColor.RGB = RGB(255, 255, 0) 'Couleur de fond jaune
             ActiveSheet.Shapes("Label2").Visible = False
  Else
             ActiveSheet.Shapes("Label2").Visible = True
 
   ActiveSheet.Shapes("Basse-Normandie").Fill.ForeColor.RGB = RGB(0, 255, 0) 'Couleur de fond vert
 End If
End Sub
 
Private Sub Image3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 If X < 10 Or X > Image3.Width - 10 Or Y < 10 Or Y > Image3.Height - 10 Then
   ActiveSheet.Shapes("Pays-de-Loire").Fill.ForeColor.RGB = RGB(255, 255, 255) 'Couleur de fond blanc
 
             ActiveSheet.Shapes("Label3").Fill.ForeColor.RGB = RGB(255, 255, 0) 'Couleur de fond jaune
             ActiveSheet.Shapes("Label3").Visible = False
  Else
             ActiveSheet.Shapes("Label3").Visible = True
 
   ActiveSheet.Shapes("Pays-de-Loire").Fill.ForeColor.RGB = RGB(0, 255, 0) 'Couleur de fond vert
 End If
End Sub
 
Private Sub Image1_Click()
  razShapes
  Sheets("bretagne").Select
End Sub
 
Private Sub Image2_Click()
  razShapes
  Sheets("Basse-normandie").Select
End Sub
 
Private Sub Image3_Click()
  razShapes
  Sheets("pays-de-loire").Select
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  razShapes
End Sub
 
Sub razShapes()
  For Each s In ActiveSheet.Shapes
    s.Fill.ForeColor.RGB = RGB(255, 255, 255)
  Next s
End Sub

Dans l'attente de vous lire je vous remercie d'avance et vous souhaite une bonne journée








Cordialement

Maval

[michoutri]

Salut

Tu peux rajouter une ligne du style :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
ActiveSheet.Shapes("Label_info1").caption=sheets("Données").range("Nombre d'habitants").value & _
chr(10) & sheets("Données").range("Nombre de jours de pluie par an").value

Par exemple...

Ciao

[maxval18]

Bonjour michoutri

Super d'avoir répondu, si tu peut regarder deux minutes mon fichier et me dire exactement se que je doit faire sa m'aiderai beaucoup

Merci @+
Max

[mercatog]

Essaies comme ceci (bien sûr à adapter)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
With ActiveSheet
    If X < 10 Or X > Image2.Width - 10 Or Y < 10 Or Y > Image2.Height - 10 Then
        .Shapes("Basse-Normandie").Fill.ForeColor.RGB = RGB(255, 255, 255)    'Couleur de fond blanc
        .Shapes("Label2").Fill.ForeColor.RGB = RGB(255, 255, 0)    'Couleur de fond jaune
        .Shapes("Label2").Visible = False
    Else
        With .Shapes("Label2")
            .Visible = True
            .TextFrame2.TextRange.Characters.Text = f("Basse-Normandie")
        End With
        .Shapes("Basse-Normandie").Fill.ForeColor.RGB = RGB(0, 255, 0)    'Couleur de fond vert
    End If
End With
End Sub
 
Private Function f(ByVal Str As String) As String
Dim c As Range
 
If Str <> "" Then
    Set c = Worksheets("Donnée").Range("C:C").Find(Str, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        f = c.Offset(1, 0)                       'ici pour l'exemple on prend l'information juste au dessous à adapter
        Set c = Nothing
    End If
End If
End Function

Tu risques avec plusieurs shapes d'avoir une usine à gaz.
Il vaudra mieux de regarder du côté des modules de Classes juimelés avec une nomination intelligente des shapes et labels.

[maxval18]

Bonjour Mercatog,

Oui j'ai 22 régions, certainement plus efficace de passer par module de classe encore faudrait il savoir comment faire et là moi????

Merci pour ce début de code sa me feras avancer toujours un petit peut

@+
max

Re,

Pourquoi je n'arrive pas a avoir toute la ligne alors que j'ai fait ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Function f(ByVal Str As String) As String
Dim c As Range
 
If Str <> "" Then
    Set c = Worksheets("Donnée").Range("C:C").Find(Str, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        f = c.Offset(1, 0).Value                       'ici pour l'exemple on prend l'information juste au dessous à adapter
        f = c.Offset(1, 1).Value
        f = c.Offset(1, 2).Value
        Set c = Nothing
    End If
End If
End Function

@+
Max

[mercatog]

Tu écrase l'ancienne f par la nouvelle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Function f(ByVal Str As String) As String
Dim c As Range
 
If Str <> "" Then
    Set c = Worksheets("Donnée").Range("C:C").Find(Str, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        f = c.Offset(1, 0).Value                   'ici pour l'exemple on prend l'information juste au dessous à adapter
        f = f & vbCrLf & c.Offset(1, 1).Value
        f = f & vbCrLf & c.Offset(1, 2).Value
        Set c = Nothing
    End If
End If
End Function