IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Info sur Label


Sujet :

Macros et VBA Excel

  1. #1
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut Info sur Label
    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

  2. #2
    Membre averti
    Homme Profil pro
    réseaux électriques
    Inscrit en
    Août 2009
    Messages
    22
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : réseaux électriques

    Informations forums :
    Inscription : Août 2009
    Messages : 22
    Par défaut réponse
    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

  3. #3
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    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
    Fichiers attachés Fichiers attachés

  4. #4
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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.

  5. #5
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    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

  6. #6
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    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

  7. #7
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    Re,

    Je te remercie j'ai du magouillé un petit peut pour faire rentrer plusieurs ligne dans le label mais je n'arrive pas a centrer les colonnes si toutefois un a une plan pour centrer les colonnes je suis preneur.

    Voici comme j'ai fait.
    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
    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 & "          " & "        " & c.Offset(1, 1).Value
            f = f & "          " & "        " & c.Offset(1, 2).Value
            f = f & "          " & "                  " & c.Offset(1, 3).Value
            f = f & vbCrLf & c.Offset(2, 0).Value
            f = f & "           " & "        " & c.Offset(2, 1).Value
            f = f & "            " & "      " & c.Offset(2, 2).Value
            f = f & "          " & "             " & c.Offset(2, 3).Value
            f = f & vbCrLf & c.Offset(3, 0).Value
            f = f & "             " & "           " & c.Offset(3, 1).Value
            f = f & "            " & "      " & c.Offset(3, 2).Value
            f = f & "          " & "             " & c.Offset(3, 3).Value
            Set c = Nothing
        End If
    End If
    End Function
    Au plaisir de te lire

    Bonne soirée

    Max

  8. #8
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonsoir
    Voila une proposition différente utilisant un module de classe, néanmoins avec une préparation stricte du classeur.

    L'idée est de montrer une image de la zone de donnée correspondant à la région survolée.

    1. Nommer toutes les régions de la feuille Donnée avec des - entre les mots au cas ou le nom de la région est un nom composé: (Exemple PAYS-DE-LOIRE). (indifféremment en majuscule ou en minuscule).

    2. Nommer les formes des régions identiquement de la même chose que les noms des régions de la feuille Donnée.

    3. Nommer les images cachées qui sont utilisées pour capter l'évènement MouseMove avec un préfixe yx et remplacer les tirets - par les underscore _ (exemple yxPays_De_Loire)

    Codes:

    1. Module ThisWorkbook (pour activer la feuille données à l'ouverture)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Private Sub Workbook_Open()
     
    Feuil5.Activate
    End Sub
    2. Module standard (Pour les fonctions et variables utilisés dans le projet)
    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
    Option Explicit
     
    Public Traced As Boolean
     
    Sub f(ByVal Str As String, ByVal Sh As Worksheet)
    Dim c As Range, v As Range
     
    Application.ScreenUpdating = False
    If Str <> "" Then
        With Worksheets("Donnée")
            Set c = .Range("C:C").Find(UCase(Trim(Str)), LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                Traced = True
                Set v = c.Offset(1, 1).End(xlDown)
                .Range(c, v.Offset(0, 2)).Copy
                Set v = Nothing
                Set c = Nothing
                Sh.Pictures.Paste
                Application.CutCopyMode = False
            End If
        End With
    End If
    End Sub
     
    Function NamePicToShp(ByVal Str As String) As String
     
    NamePicToShp = Mid(Replace(Str, "_", "-"), 3)
    End Function
    3. Module de classe, nommé ClasseImages. Utilisé pour écrire le code MouseMove
    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
    Option Explicit
     
    Public WithEvents Img As MSForms.Image
     
    Private Sub Img_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Shp As Shape
    Dim ShpName As String
     
    ShpName = NamePicToShp(Img.Name)
    With ActiveSheet
        Set Shp = .Shapes(ShpName)
        If X < 10 Or X > Img.Width - 10 Or Y < 10 Or Y > Img.Height - 10 Then
            Shp.Fill.ForeColor.RGB = RGB(255, 255, 255)    'Couleur de fond blanc
            Traced = False
            If .Shapes(.Shapes.Count).Type = 13 Then .Shapes(.Shapes.Count).Delete
        Else
            Shp.Fill.ForeColor.RGB = RGB(0, 255, 0)    'Couleur de fond vert
            Intersect(Shp.TopLeftCell.EntireRow, .Columns(7)).Select
            If Not Traced Then f Shp.Name, Shp.Parent
        End If
        Set Shp = Nothing
    End With
    End Sub
    4. Module de la feuille, pour instancier les éléments image dans la classe ClasseImage (sur Activate) et pour initialiser l'état des variables (sur Desactivate)

    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
    Option Explicit
     
    Dim MaClasse() As New ClasseImages
     
    Private Sub Worksheet_Activate()
    Dim Ctrl As OLEObject
    Dim i As Integer
     
    For Each Ctrl In ActiveSheet.OLEObjects
        If Left(Ctrl.Name, 2) = "yx" Then
            i = i + 1
            ReDim Preserve MaClasse(1 To i)
            Set MaClasse(i).Img = Ctrl.Object
        End If
    Next Ctrl
     
    End Sub
     
    Private Sub Worksheet_Deactivate()
     
    Traced = False
    Erase MaClasse
    End Sub
    Enfin Clique ici sur le lien vers le fichier

    L'avantage, tu as 6 shapes ou 36 sur ta feuille, tu n'as aucun ligne de code à ajouter hormis le respect des points de préparation du fichier décrit ci-haut.

    Tu remarques aussi que si tu as plusieurs feuilles, on peut créer un module de classe pour y instancier les feuilles dont on désire affecter le code Activate (qui instancie notre classe images)
    Bonne application sans hâte.

  9. #9
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    Bonsoir ou bonjour vue l'heure!

    Je te remercie du super travail que tu as fait, mais j'ai un petit souci message d'erreur "Incompatibilité de type" sur module de classe a se niveau:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If Not Traced Then f Shp.Name, Shp.Parent
    Bonne nuit a demain

    Max

  10. #10
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour
    As tu testé sur le fichier joint?

    je viens de re tester ce matin au boulot sur Excel 2007, il y a un petit problème de suppression des vues créées. Pour corriger ce petit désagrément, ci-après modifications apportées et testée.

    1. J'ai ajouté une sub dans le module standard qui supprimes toutes les images Shp.Type=13
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    Sub DeletePictures()
    Dim Shp As Shape
     
    For Each Shp In Feuil1.Shapes
        If Shp.Type = 13 Then Shp.Delete
    Next Shp
    End Sub
    2. J'ai modifié légèrement le code du module de classe
    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
    Private Sub Img_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Shp As Shape
    Dim ShpName As String
     
    ShpName = NamePicToShp(Img.Name)
    With ActiveSheet
        Set Shp = .Shapes(ShpName)
        If X < 10 Or X > Img.Width - 10 Or Y < 10 Or Y > Img.Height - 10 Then
            Shp.Fill.ForeColor.RGB = RGB(255, 255, 255)    'Couleur de fond blanc
            Traced = False
            DeletePictures
        Else
            Shp.Fill.ForeColor.RGB = RGB(0, 255, 0)  'Couleur de fond vert
            Intersect(Shp.TopLeftCell.EntireRow, .Columns(7)).Select
            If Not Traced Then f Shp.Name, Shp.Parent
        End If
        Set Shp = Nothing
    End With
    End Sub
    Le reste sans changement.

    Ci-joint la version modifiée

  11. #11
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    Bonjour Mercatog

    Je viens de télécharger le nouveau fichier j'ai le même message d'erreur.

    @+

    Max

  12. #12
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Je n'y peux rien, j'ai Excel 2007 et ça fonctionne sans problème. Si quelqu'un de passage pourrait tester le fichier.

    Edit: Ici une capture de la feuille avec le résultat affiché http://www.hostingpics.net/viewer.ph...72Capture1.jpg

    PS. J'ai une réflexion d'amélioration, quand tu vas faire fonctionner le fichier, j'en parlerai

  13. #13
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    Re,

    Je vais installer excel sur un autre ordinateur que je viens d'acheter et faire un essai, mais je ne comprend pas pourquoi que sa fonctionne chez mais pas chez moi?

    @+

    Max

    Re,

    Je viens de l'installer sur un autre ordinateur que je viens d'acheter et j'ai le même message. Ou alors que tu as une otption que je n'est pas?

    A te lire

    @+
    Max

  14. #14
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Je ne sais pas quelle option. Tu teste sur mon fichier ou sur le tiens?
    Tu as compilé le projet? (Dans Editeur vba> Débogage > Compiler VBAprojet)
    Est ce que tu as mis des points d'arrêt avant la ligne en question pour voir la valeur des variables?

  15. #15
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    Re,

    Oui je travaille sur le dernier que tu ma envoyer

    si je supprime Not je n'ai plus de message d’erreur mais la fenêtre de droite ne s'ouvre pas?

  16. #16
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Regarde ce que tu auras avec seulement cette ligne à la place de
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If Not Traced Then f Shp.Name, Shp.Parent
    La variable Traced a été ajouté pour ne pas effacer et créer la vue sur chaque mouvement de la souris à l'intérieur de la shape. (C'est à dire, tant que le curseur bouge à l'intérieur de la shape, la vue est crée une seule fois)

  17. #17
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    Re,

    Nom toujours pareil je suis désespérer surtout après avoir vue le résultat que tu ma envoyer.

    Je viens de mettre le fichier dans un troisième ordi et toujours pareil

  18. #18
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    respire un peux et relis les remarques du code initial.
    Pour instancier ta classe (et pour que le code fonctionne), tu dois activer une autre feuille et réactiver Feuil1

  19. #19
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    re;
    Oui je sais jusque la il n'y a pas de problème mais je suis sur que l'on va y arriver.
    Comme j'ai beaucoup de patience il ne devrait pas y avoir de problème

    Bonjour,

    Pour l'ami Mercatog et voir se qu'il en pense. J'ai fait comme j'ai peut en emploient un USF ?

    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
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
     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
     
             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
        Unload User
        Else
     
                        ActiveSheet.Shapes("Label2").Visible = True
     
            With ActiveSheet.Shapes("Label5")
                .Visible = True
                .TextFrame2.TextRange.Characters.Text = f("Basse-Normandie")
            End With
     
            ActiveSheet.Shapes("Basse-Normandie").Fill.ForeColor.RGB = RGB(0, 255, 0)    'Couleur de fond vert
          User.Show
     
        End If
    End With
    End Sub
     Private Sub Image1_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
             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
        Unload User
        Else
     
                        ActiveSheet.Shapes("Label2").Visible = True
     
            With ActiveSheet.Shapes("Label5")
                .Visible = True
                .TextFrame2.TextRange.Characters.Text = f("bretagne")
            End With
            ActiveSheet.Shapes("bretagne").Fill.ForeColor.RGB = RGB(0, 255, 0)    'Couleur de fond vert
          User.Show
     
        End If
    End With
    End Sub
      Private Function f(ByVal Str As String) As String
     Dim c As Range, t As Variant
     If Str <> "" Then
            Set c = Worksheets("Donnée").Range("C:C").Find(Str, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                    t = Sheets("Donnée").Range("c" & c.Row & ":h" & c.Row + c.Offset(0, -1).Value)
                    User.ListBox1.List = t
     End If: End If
     End Function
     
    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
    Mais reste un problème si je supprime le label5 physiquement et dans se morceau de code je n'ai plus de donnée sur mon User.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
      With ActiveSheet.Shapes("Label5")
                .Visible = True
                .TextFrame2.TextRange.Characters.Text = f("Basse-Normandie")
            End With
    Bonne journée

    Max

  20. #20
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 179
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 179
    Billets dans le blog
    53
    Par défaut
    Bonjour Mercatog,
    Citation Envoyé par mercatog Voir le message
    Je n'y peux rien, j'ai Excel 2007 et ça fonctionne sans problème. Si quelqu'un de passage pourrait tester le fichier.
    Edit: Ici une capture de la feuille avec le résultat affiché http://www.hostingpics.net/viewer.ph...72Capture1.jpg
    PS. J'ai une réflexion d'amélioration, quand tu vas faire fonctionner le fichier, j'en parlerai
    Testé sur Office 2007 SP3 - FR, Windows XP
    J'ai également un message d'erreur à l'ouverture du classeur dès que j'active les macros.
    Le message d'erreur est
    Erreur 1004. Impossible de lire la propriété Object de la classe OLEObject
    A cette ligne qui est mise en rouge
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    Option Explicit
    Dim MaClasse() As New ClasseImages
    Private Sub Worksheet_Activate()
    Dim Ctrl As OLEObject
    Dim i As Integer
    For Each Ctrl In ActiveSheet.OLEObjects
        If Left(Ctrl.Name, 2) = "yx" Then
            i = i + 1
            ReDim Preserve MaClasse(1 To i)
            Set MaClasse(i).Img = Ctrl.Object
        End If
    Next Ctrl
    End Sub
    N'ayant pas vraiment suivi ce post et l'ayant lu en diagonale, je ne sais pas s'il fallait faire quelque chose de particulier au préalable.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

Discussions similaires

  1. Cherche lien info... sur l'analyse du code
    Par Alec6 dans le forum Qualimétrie
    Réponses: 3
    Dernier message: 03/03/2004, 14h44
  2. Récupérer des infos sur un AVI
    Par FredericB dans le forum C++Builder
    Réponses: 2
    Dernier message: 08/12/2003, 14h25
  3. Demande d'info sur treeview
    Par Anaxagore dans le forum IHM
    Réponses: 6
    Dernier message: 28/08/2003, 18h27
  4. [MFC]Info sur da la fusion sous Word
    Par kor dans le forum MFC
    Réponses: 6
    Dernier message: 22/08/2003, 11h14
  5. [CR] Infos sur l'utilisation de dll
    Par step dans le forum SAP Crystal Reports
    Réponses: 11
    Dernier message: 09/08/2002, 11h35

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo