Discussion :

[cerede2000]

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

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

[Invité]

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 :

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

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 :

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

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 :

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

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 :

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

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

[patricktoulon]

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

[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!

[patricktoulon]

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 !!!

[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!

[cerede2000]

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

Tu est trop fort !

C'est super mortel ton truc

Merci

[patricktoulon]

e bonjour a tous

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

[cerede2000]

Coool, je suis pressé de voir les améliorations

[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!

[cerede2000]

Ah oui pas mal aussi

Tu peux illustrer ?

[Invité]

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



Mais dès que je retrouve ma prothèse 64bits pas de problème!

[patricktoulon]

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


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

[Philippe PONS]

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

Code :

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

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

[patricktoulon]

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

[cerede2000]

Super !!!!!!!



@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 :

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
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 ?

[patricktoulon]

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

[Invité]

Bonjour,

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!

[cerede2000]

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

fausse classe controls V 1.4.xls

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

Code :

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

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

[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!