Detecter le control d'un Userform sur clic

Version imprimable

Voir 40 message(s) de cette discussion en une page

18/03/2016, 07h57
cerede2000

Oua les gars !
J'arrive ce matin sur le forum et je vois mon poste remonter, vous êtes parti dans un sacré truc !! :mouarf:

Je ne savais même pas qu'il était possible de faire cohabiter du VBA avec du VBS !
Ca rends le truc puissant du coup :)

Oui mais ce sera une bonne nouvelle que quand le évènements comme Click seront pris en compte, la c'est encore de l'utopie!

Code:

1
2
3
4
scr.AddObject "This", Me, True 'permet d'associer tout ton UserForm au code Vbs.
'This étant le nom virtuel de ton UserForm côté Vbs
'Note que je pouvais écrire Toto plutôt que This!
'Me étant to UserForm côté Vba

Code:

1
2
3
'Ici on défini ton module de classe un peut cemme Vba mais c'est dans le même scripte
code = "class MyserForm" & vbCrLf
code = code & "end class" & vbCrLf

Code:

1
2
'et on rentre dans un phase classique comme dans le code que Patrick ta sen doute remis!
code = code & "set a=new MyserForm" & vbCrLf

Code:

1
2
3
'Ici nous sommes côté Vbs, mais si tu place un point d'arrêt dans la sub test de ton userform
'tu verra qu'il y a bien interactions!
code = code & "This.test(This.Label1.name) " & vbCrLf

18/03/2016, 10h31
patricktoulon

re

bonjour tout les deux

cerede2000: nous on s'amuse très souvent avec ca vba/vbs ca permet de faire du multitâche en cas de gros ou nombreux traitement

rdurupt :oui mais l'évènement walouh walouh
j'ai beau chercher je ne trouve pas

question:
1° et il possible de coder en vba dans le script control
2 le src étant un Object instancié par vba comme dans ton exemple finalement il boucle en réinitialisant la classe
ne bloque t il pas tourne dans le vide

3 a tu essayer d'envoyer me dans un fichier vbs
18/03/2016, 10h51
Invité

Oui il est possible d'envoyer ME dans un fichier VBS mas il faut que je regarde comment on le passe en paramètre car je ne me souviens pas!
18/03/2016, 16h48
patricktoulon

2 pièce(s) jointe(s)

re

bon en attendant je suis parti de mon idée de régions mais les apis etant un peut difficile a a manipuler gdi je touche moins
et utiliser une image transparente comme tapis de curseur

mais j'ai créé mes régions dans 2 dico même pas 25 lignes de code ca fonctionne du tonnere
et tout ca sans api ni classe

y a qu'un toulonnais pour inventer ca hein !!! :ptdr::aie::mouarf:
Pièce jointe 204295
18/03/2016, 17h13
Invité

Bonjour Patrick!
ce vachement bien le résultat est là et c'est suffisant!

je n'es pas trouvé, mais maintenant je peux le faire en délitant!

on peux affecté le onclick d'un contrôle HTML mais un contrôle d'un UF c'est une autre père de manche!
19/03/2016, 10h17
cerede2000

Oua !!!!!!!!!!!

Tu est trop fort !

C'est super mortel ton truc :)

Merci :ave::ave:
19/03/2016, 10h26
patricktoulon

1 pièce(s) jointe(s)

re

e bonjour a tous

attend cerece2000 je l'ai amélioré depuis hier
je suis en train de le parfaire

Pièce jointe 204331
19/03/2016, 10h41
cerede2000

Coool, je suis pressé de voir les améliorations :)
19/03/2016, 11h56
Invité

Bonjour,
Il y a une autre solution à laquelle je lavais pas pensé!

Chaque contrôle dispose d'événements intrinsèque (prise de focus, perte de focus, click,...)

A l'ouverture le userform donne le focus au premier contrôles de la collection.
Si je j'applique cet objet a un variable je peux intercepté ses évènements losefocus par exemple et lui appliqué le nouveau contrôle actif et donc intercepté l'événement click.

Je trouve la solution de Patrick des plus parfaite, mais vu que notre ami a trouvé sa solution,soit par des modules de classe soit par la dernière proposition de Patrick, alors pourquoi pas raisonner sur les différentes formes de solution!

Vu ce que Patrick a déjà proposé, moi aussi j'ai hâte de voir!
19/03/2016, 12h16
cerede2000

Ah oui pas mal aussi :)

Tu peux illustrer ? :D
19/03/2016, 13h02
Invité

1 pièce(s) jointe(s)

Actuellement, taches ménagère oblige, là je fais ma pose impériale, donc je surf.

Pièce jointe 204344

Mais dès que je retrouve ma prothèse 64bits pas de problème!
19/03/2016, 15h21
patricktoulon

2 pièce(s) jointe(s)

allez version 1.2

re et voila la neWversion 1.2

maintenant que la mécanique et bien comprise en tout ca pour moi j'ai un peu modifié
c'est maintenant adaptable a n'importe quel userform
il suffit de mettre "classe" dans le tag du control pour les contrôles existants
ma vraie fausse classe ;) gère le mouse over, mouse out, mouse click
elle st beaucoup plus précise avec les interstices(espace entre chaque controls) j'ai mis des commentaire en pagaille
démo en image et pièce jointe
Pièce jointe 204357

alors c'est pas la classe ca!!!???? et allez encore un jeu de mot ramoutcho

et pour éviter l'affichage d'une boite vide quand on clique entre 4 contrôles,
il faut écrire:
Code:

1 2 3 4 If Not IsEmpty(dicobouton(col & "*" & lig)) Then sub_comune dicobouton(col & "*" & lig) End If

19/03/2016, 22h23
patricktoulon

1 pièce(s) jointe(s)

re

re
bonsoir philippe pons

je te remercie mais j'avais déjà corrigé autrement l'intercession centrale entre 4 contrôles

ma méthode annihile aussi l'effet vibrateur l'ors du déplacement de la souris

tiens en pièces jointe
je cherche d'autre amélioration avant de le déposer dans les contribs

Super !!!!!!!

:applo::applo:

@patricktoulon excellent boulot :)

Après étude du code, j'ai modifié un peu le fonctionnement pour le rendre plus réactif et complètement éliminer les effet de vibration.

L'idée, créé un tableau de coord X/Y de la taille de calque.
Parcourir les controls LBL de la matrice et dans le tableau coord mettre le nom du LBL aux coord du LBL.

Ensuite MouseHover et MouseClic n'ont plus qu'as accéder à X/Y du tableau pour connaitre le LBL qui s'y trouve (s'il y en a un :) ).
Du coup plus de boucle dans les mousehover et mouseclic.

Code:

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
Dim tabCoord() As String
 
Private Sub UserForm_Activate()
    Dim i, j As Integer, n As Long
    Dim curLbl As MSForms.Label
 
    For i = 0 To 9
        For j = 1 To 10
            n = n + 1
            'Debug.Print n
            Set curLbl = Me.Controls.Add("Forms.Label.1", "LB" & (3 * i + j), True)
            With curLbl
                .Caption = "LB" & n
                .Width = 20
                .Height = 20
                .Top = 10 + (20 * i) + 8 * i
                .Left = 10 + (20 * (j - 1)) + 8 * j
                .BorderStyle = 1
                .Font.Size = 6
                .Name = "LB" & n
                .BackColor = ThisWorkbook.Colors(3 + (Rnd * 30))
                .Tag = "classe"    'on tag le control pour le prendre en compte dans ma vraie fause classe mort de rire
                .ZOrder 0
            End With
        Next j
    Next i
 
    classing    'ON INITIALYSE LA  FAUSSE CLASSE apres avoir construit les controls en appelant la sub "classing"
 
    Dim maxX, maxY As Integer
 
    maxX = ActiveWindow.PointsToScreenPixelsX(calque.Width)
    maxY = ActiveWindow.PointsToScreenPixelsY(calque.Height)
 
    ReDim tabCoord(maxX, maxY)
 
    Dim ctrl As Object
    Dim xDebut, xFin, yDebut, yFin
 
    For Each ctrl In Me.Controls
        If InStr(ctrl.Tag, "|") > 0 Then
            xDebut = ActiveWindow.PointsToScreenPixelsX(ctrl.Left)
            xFin = ActiveWindow.PointsToScreenPixelsX(ctrl.Left + ctrl.Width)
 
            yDebut = ActiveWindow.PointsToScreenPixelsY(ctrl.Top)
            yFin = ActiveWindow.PointsToScreenPixelsY(ctrl.Top + ctrl.Height)
 
            For i = xDebut To xFin
                For j = yDebut To yFin
                    tabCoord(i, j) = ctrl.Name
                Next
            Next
        End If
    Next
End Sub
 
Private Sub calque_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'l 'evenement de la vraie fausse classe est géré par le control image
' ici on va créer le mouse over et mouse out
 
    If Not oldcontrol Is Nothing Then
        oldcontrol.BackColor = Split(oldcontrol.Tag, "|")(0)
    End If
 
    Dim ctrlName As String
    ctrlName = tabCoord(ActiveWindow.PointsToScreenPixelsX(X), ActiveWindow.PointsToScreenPixelsY(Y))
    If ctrlName <> vbNullString Then
        Set oldcontrol = Me.Controls(ctrlName)
        Set newcontrol = Me.Controls(ctrlName)
 
        Label1.Caption = tabCoord(ActiveWindow.PointsToScreenPixelsX(X), ActiveWindow.PointsToScreenPixelsY(Y))
 
        newcontrol.BackColor = vbWhite
    End If
End Sub

Qu'en pensez vous ?

20/03/2016, 12h29
patricktoulon

re

Bonjour cerede2000

ca marche pas ton truc y a plein d'erreur et de manque noamaent le premier oldcontrol qui n'est pas determiné
ensuite après avoir gérer toutes ces erreurs ca ne marche pas du tout ca fait rien

j'ai pas analysé a fond mais si je comprends bien ton raisonnement
tu met les point topleft dans tabcoord

et après tu espère sans boucle tomber avec les x y du claque sur les item correspondant
ca peut marcher que si la souris se trouve en haut a gauche du control et encore j'en suis pas sur !!!

je regarderais ce soir en rentrant
sinon l'idée est intéressante un+1 rien que pour la tentative
20/03/2016, 12h39
Invité

Bonjour,

Citation:

ca peut marcher que si la souris se trouve en haut a gauche du control et encore j'en suis pas sur !!!

En effet mais ils faut tenir compte de la surface occupé par le contrôle et en déduire la position en haut a gauche en imaginant qu'il ne puisse pas y avoir de confusion entre les calque!
20/03/2016, 12h40
cerede2000

1 pièce(s) jointe(s)

Voici le fichier en 1.4 pour preuve que ça fonctionne bien :)

Pièce jointe 204436

Beaucoup plus léger, tout est géré à l'initialisation.
Me reste un truc à régler, à ce niveau là :

Code:

ReDim Preserve tabCoord(500, 500)

Vu qu'on peux pas Redim Preserve sur 2D alors qu'il faudrait dynamiquement agrandir en même temps que le calque.

Edit : Pour vous représentez le fonctionnement imaginez une matrice qui contient l'emplacement des labels en fonction des coordonnées de la souris.

Edit 2 : Petit soucis aussi en fonction de la position de la fenêtre (coordonnées négative), il faut régler ça
20/03/2016, 12h50
Invité

Tu ne peux pas redimensionner en 2D mais tu peux surdimensionné ton tableau et en déduire un autre de la bonne dimension!
em même temps un table de 14 valeur donnera 0 sur modulo 7 donc 15 modulo 7 donnera1!

((15 - (15 modulo 7))/7) + iif((15 modulo 7)>0,1,0) donnera la ligne 3
Et 15 modulo 7 donnera la colonne 1!

Voir 40 message(s) de cette discussion en une page