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

VBA Access Discussion :

[VBA-A]Détection souris sur un objet.


Sujet :

VBA Access

  1. #1
    Membre averti
    Profil pro
    Inscrit en
    Février 2006
    Messages
    22
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Février 2006
    Messages : 22
    Par défaut [VBA-A]Détection souris sur un objet.
    Salut à tous,

    Je tente de construire une petite application avec des objets (des Labels) dynamiques. J'ai réussi jusqu'à maintenant à partir de code trouvé sur Internet à faire à peu près tout ce dont j'ai besoin sauf une petite chose.

    Ce que je tente de faire, c'est de mettre en surbrillance le texte d'un label lorsque la souris passe dessus exactement comme un URL dans une page Web.

    La première partie fonctionne, c'est à dire que le texte devient en bleu et souligné quand la souris passe dessus (zoLabel_MouseMove dans la Classe).

    Ce que je ne réussi pas à faire c'est que ça s'annule quand la souris n'est plus sur le texte précédemment mis en surbrillance.

    Voici le 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
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
     
     
    ***** Feuille FrmControlArray *****
     
    Option Explicit
    Option Compare Text
     
    Private oControlArray() As CtrlArray
    Private Const clControlCount As Long = 5
     
    Public Sub DoSomethingWithClick(LabelText As String)
        MsgBox LabelText
    End Sub
     
    Private Sub CmdClose_Click()
        Unload Me
    End Sub
     
    Private Sub UserForm_Initialize()
     
        Dim ThisBox As Long, NewLabel As Control 
     
        ReDim oControlArray(1 To clControlCount)
     
        For ThisBox = 1 To clControlCount
            Set NewLabel = Me.Controls.Add("Forms.Label.1")
            With NewLabel
                .Left = 10
                .Top = 15 * ThisBox
                .Height = 12
                .Width = 100
                .Visible = True
                .Caption = "LABEL : " & ThisBox
                .BorderStyle = 0
            End With
            Set oControlArray(ThisBox) = New CtrlArray
            oControlArray(ThisBox).Initialise NewLabel, ThisBox
        Next
     
        Set NewLabel = Nothing
     
    End Sub
     
    Private Sub UserForm_Terminate()
        Dim ThisBox As Long
        For ThisBox = 1 To clControlCount
            Set oControlArray(ThisBox) = Nothing
        Next
    End Sub
     
     
    ***** Classe CtrlArray *****
     
    Option Explicit
    Option Compare Text
     
    Private WithEvents zoLabel As MSForms.Label
    Private zlIndex As Long
     
    Private Sub zoLabel_Click()
        Call FrmControlArray.DoSomethingWithClick(zoLabel.Caption)
    End Sub
     
    Private Sub Class_Terminate()
        Set zoLabel = Nothing
    End Sub
     
    Sub Initialise(oControl As Object, lControlIndex As Long)
        zlIndex = lControlIndex
        Set zoLabel = oControl
    End Sub
     
    Property Get Index() As Long
        Index = zlIndex
    End Property
     
    Function Control(sName As String) As Object
            Set Control = zoLabel
    End Function
     
    Private Sub zoLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        With zoLabel
            .ForeColor = vbBlue
            .Font.Underline = True
        End With
    End Sub
    Notez que c'est du VBA et non du VB6 (Important)

    Je n'ai rien d'un professionnel en VBA alors soyez indulgent. C'est d'ailleurs la raison pour laquelle je cherche de l'aide :-)

  2. #2
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Par défaut
    Pour faire ça, tu dois réinitialiser ta couleur dans le mouse_move de ton userform.

    A+

  3. #3
    Membre averti
    Profil pro
    Inscrit en
    Février 2006
    Messages
    22
    Détails du profil
    Informations personnelles :
    Localisation : Canada

    Informations forums :
    Inscription : Février 2006
    Messages : 22
    Par défaut
    Voici ce que j'ai tenté :

    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
     
    ***** Dans ma classe j'ai ajouté *****
     
    Function ResetLinks()
        With zoLabel
            .ForeColor = vbBlack
            .Font.Underline = False
        End With
    End Function
     
    ***** Dans mon Userform j'ai ajouté ceci *****
     
    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Dim Count As Long
        For Count = 1 To clControlCount
            oControlArray(Count).ResetLinks
        Next
    End Sub
    Ca fonctionne mais c'est pénible car ça boucle continuellement quand la souris bouge... De plus, l'utilisation processeur grimpe de façon inquiétante :-(

    J'ai aussi tenté, à la suggestion d'un confrère de travail, de mettre un autre label en dessous de celui que je veux modifié. De ce fait, quand le curseur quite le label du dessus il doit inévitablement passer sur le label du dessous qui réinitialise celui du dessus...

    Le seul hic c'est que quand la souris passe trop rapidement sur le label le résultat n'est pas constant...

    Il ne faut pas oublier que le but est de créer plusieurs Labels dans un UserForm (de 1 à 200 environs). Alors plus on ajoute de label plus les labels clignotent. C'est tout à fait normal compte tenu des boucles à répétition.

    Auriez-vous d'autre suggestions?

  4. #4
    Expert confirmé
    Avatar de ThierryAIM
    Homme Profil pro
    Inscrit en
    Septembre 2002
    Messages
    3 673
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 62
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Secteur : Industrie

    Informations forums :
    Inscription : Septembre 2002
    Messages : 3 673
    Par défaut
    travailler le X et le Y dans zoLabel_MouseMove :

  5. #5
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Par défaut
    Si c'est ce à quoi je pense, en effet, définir une plage xy, dans le zolabel lui-même, en dehors de laquelle la surbrillance est désactivée, règlerait le problème. Pour ça, tu as
    Hauteur de zolabel = zolabel.height
    Largeur = zolabel.width
    position X = zolabel.left
    position Y = zolabel.top

    Ta plage devra se situer entre left et left + Width et entre top et top + height

    Tu fais tes calculs et tu dis...

    A+

Discussions similaires

  1. détection de clic de souris sur un objet pixmap
    Par bouchecousue dans le forum Qt
    Réponses: 16
    Dernier message: 15/05/2008, 13h09
  2. [DX9][C#]Détection clic souris sur un modèle 3D
    Par lancer83 dans le forum DirectX
    Réponses: 2
    Dernier message: 31/07/2006, 17h58
  3. [VBa-E] question(s) sur l'objet OLE "image Bitmap"!
    Par gootsu dans le forum Macros et VBA Excel
    Réponses: 41
    Dernier message: 28/07/2006, 17h37
  4. [SWING] Evenement (souris) sur un objet Chartpanel
    Par rprom1 dans le forum AWT/Swing
    Réponses: 1
    Dernier message: 20/04/2006, 10h10
  5. Réponses: 5
    Dernier message: 12/04/2005, 13h54

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