encore un truc qui me rend dingue associer un evenemnt a l'userform dynamique dans la classe

Version imprimable

Bonjour a tous

et voila pour changer encore un truc que je pige pas
je voudrais associer les evenement mousedown,click,doubleclik et mousemove a l'userform dynamique dans la classe
rien n'y fait je dois rater quelque chose

sub d'appel

Code:

1
2
3
4
Sub test()
Dim snap As New snapshot
snap.create_ZoneCapture
End Sub

module classe nommé snapshot

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
 
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'capturer le handle et pouvoir le deplacer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Dim cl(2) As New snapshot
Public WithEvents forme As UserForm
Sub create_ZoneCapture()
    Dim mehwnd As Long, maform, nom
    Set maform = ThisWorkbook.VBProject.VBComponents.Add(3)
    nom = maform.Name
    VBA.UserForms.Add (nom)
    Set maform = UserForms(UserForms.Count - 1)
    Set cl(1).forme = maform
    maform.Show 0: maform.BackColor = vbMagenta
    mehwnd = FindWindowA(vbNullString, nom)    'Recupere le handle de la fenêtre
    SetWindowLong mehwnd, -16, &H94080080: SetWindowLong mehwnd, -20, &H0:    ' sans caption
    SetWindowLong mehwnd, -20, &H80000    'pour ajouter l'attribut transparent à la fenêtre on prend en compte la totalite de sa surface
     SetLayeredWindowAttributes mehwnd, 0, 20, &H2    'Definie la transparence de la fenêtre dans l'argumen(3) de 0 à 255
End Sub
Private Sub forme_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    MsgBox forme.Name
    mehwnd = FindWindowA(vbNullString, UserForm3)    'Recupere le handle de la fenêtre
    ReleaseCapture
    SendMessage mehwnd, &HA1, 2, 0&
End Sub

si vous avez une idée ne surtout;) pas se gêner

29/10/2017, 08h59
unparia

Bonjour Patrick
regarde ce que tu as écrit ici :

Code:

mehwnd = FindWindowA(vbNullString, UserForm3)

Je m'arrête là car tu sais pourquoi (je ne veux pas participer - ni de près ni de loin - à un détournement de la vocation d'un TABLEUR ;)).
Bon dimanche.

1 pièce(s) jointe(s)

bonjour jacques

oui effectivement j'aurais du le mettre entre guillemet
le nom était bon car l'userform créé aura toujours ce nom puisqu'il est supprimé dans son dblclick

mais j'ai fait autrement pour le nom (property get/let)

mais l'erreur n'était pas la tu a lu en diagonale
le soucis était que l'évènement ne se substituait pas dans la classe alors même avec l'erreur du nom l erreur n'était même pas déclenchée

le problème était que je dimais l'instance de la classe dans la sub d'appel c'était en début de module qu'il fallait l'instancier tout bêtement

cela dit j'ai un autre soucis

certaine propriétés ne se gère pas dans une classe (forme.width,.height,.top,.caption.etc..... : les modules classe ne le gèrent pas comme tel)

et j'ai absolument besoins de récupérer les coordonnées de l'userform pour créer le chart a la bonne taille ( code mis en commentaire dans l'evenement dblclik)et remplacé par un paste sur sheet
sub d'appel

Code:

1
2
3
4
5
 
Dim snap As New snapshot
Sub test()
snap.Select_ZoneCapture
End Sub

module classe nommé "snapshot"

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
 
Option Explicit
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long
Private Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
'pouvoir le deplacer
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "User32" () As Long
'api pour capture basic
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As Integer) As Long
 
Dim cl As New snapshot
Public WithEvents forme As UserForm
Private Nnom As String
Private nhandle As Long
Private Nusf As UserForm
Property Get handle() As Long: handle = nhandle: End Property    ' Propriété en lecture
Property Let handle(handle As Long): nhandle = handle: End Property    ' Propriété en écriture
Property Get nom() As String: nom = Nnom: End Property    ' Propriété en lecture
Property Let nom(nom As String): Nnom = nom: End Property    ' Propriété en écriture
'ici ca ne fonctionne pas pour l'usf
Property Get usf() As UserForm: Set usf = Nusf: End Property   ' Propriété en lecture
Property Let usf(usf As UserForm): End Property    ' Propriété en écriture
Sub Select_ZoneCapture()
    Dim handle As Long, maform
    Set maform = ThisWorkbook.VBProject.VBComponents.Add(3)
    VBA.UserForms.Add (maform.Name)
    Set maform = UserForms(UserForms.Count - 1)
    maform.Show 0: maform.BackColor = vbRed
    handle = FindWindowA(vbNullString, maform.Name)     'Recupere le handle de la fenêtre
    SetWindowLong handle, -16, &H94080080: SetWindowLong handle, -20, &H0: DrawMenuBar handle   ' sans caption
    SetWindowLong handle, -20, &H80000    'pour ajouter l'attribut transparent à la fenêtre on prend en compte la totalite de sa surface
    SetLayeredWindowAttributes handle, 0, 60, &H2    'Definie la transparence de la fenêtre dans l'argumen(3) de 0 à 255
    SetWindowPos handle, -1, 0&, 0&, 0&, 0&, (&H1 Or &H2)    'reste toujours en premier plan
    'intégration de l'userform et son non et son handle dans les variable de la classe
    Set cl.forme = maform
    cl.handle = handle
    cl.nom = maform.Name
    'Set cl.usf = maform
End Sub
Private Sub forme_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ReleaseCapture
    SendMessage handle, &HA1, 2, 0&
End Sub
Private Sub forme_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim hPicAvail
    With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
    'Definie la transparence de la fenêtre dans l'argumen(3) de 0 à 255 ici completement transparent
    SetLayeredWindowAttributes handle, 0, 0, &H2
    'capture
    keybd_event &H2C, 1, 0, 0: keybd_event &H2C, 1, &H2, 0    'on appuie et  on relache la touche snapshot
    'on va boucler tant que le contenu du clipboard n'est pas BITMAP soit (2) le temps necessaire a ce que
    'la touche print excecute sa tache et envoie les informations au clipboard
    Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop While hPicAvail = 0    'Or (Timer - T) > 1000
    'l'object forme(userform) ne gere pas le width et height dans un module classe
    'comment faire???
    'crée un graphique
    ' With ActiveSheet.ChartObjects.Add(0, 0, forme.Width, forme.Height)
    '.Chart.Paste:    ' .Chart.Export chemin, "jpg"    'colle l'image dans graphique puis exportation  le graphique en image jog
    '.Delete
    'End With
    ActiveSheet.Paste
    Unload forme
    On Error Resume Next
    With ThisWorkbook.VBProject.VBComponents: .Remove .Item(nom): End With
    On Error GoTo 0
End Sub

Pièce jointe 323175

29/10/2017, 20h35
unparia

Citation:

mais l'erreur n'était pas la tu a lu en diagonale

Ne te méprends pas -->>
J'ai ouvert cette discujssion et :
- y ai vu (elle était en plein centre) une boulette (ainsi qu'un défaut de conception, d'ailleurs, mais dont je n'ai pas parlé)
- j'ai signalé cette boulette trop visible
- j'ai ensuite vu la finalité de ta démarche et suis donc sorti de cette discussion (relis ce que j'en ai dit dans mon premier message). ;)

Bonjour,

Citation:

certaine propriétés ne se gère pas dans une classe (forme.width,.height,.top,.caption.etc..... : les modules classe ne le gèrent pas comme tel)

Pour gérer ces propriétés, Patrick, il te faut une variable Object et non MsForms.Userform.

Regarde ce test :

Code:

1
2
3
4
5
6
7
8
'Module
Option Explicit
 
Dim snap As New snapshot
 
Sub test()
snap.Select_ZoneCapture
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
'Module de classe snapshot
Option Explicit
 
Public WithEvents forme As MsForms.UserForm
Private Nusf As Object
 
Sub Select_ZoneCapture()
    Dim handle As Long, maform
    Set maform = ThisWorkbook.VBProject.VBComponents.Add(3)
    VBA.UserForms.Add (maform.Name)
    Set maform = UserForms(UserForms.Count - 1)
    maform.Show 0: maform.BackColor = vbRed
    Set forme = maform
    Set Nusf = maform
End Sub
 
Private Sub forme_DblClick(ByVal Cancel As MsForms.ReturnBoolean)
    Nusf.Width = Nusf.Width * 1.25
    Nusf.Height = Nusf.Height * 1.25
    Nusf.Caption = "UserForm Toulonnais"
End Sub

18/12/2017, 09h51
patricktoulon

re

Bonjour franck

essaie ton raisonnement dans un module classe ;)

Code:

public withevents Nuf as object'pour un userform
18/12/2017, 09h54
pijaku

Patrick,

Je ne t'ai pas dit de l'affecter WithEvents...
Allons, regarde ce que je t'ai transmis.
Tu affectes ton userform à deux variables :
forme ==> WithEvents As Userform
Usf ==> As Object

C'est toujours le même userform, mais tu bénéficies :
> grâce à WithEvents As UserForm ==> des événements
> grâce à usf As Object ==> des propriétés souhaitées.

re
Ok bien vu

c'est mieux que mon astuce
qui consistait a le re récupérer en object userform a savoir ( set nuf=forme.controls(1).parent)dans les evenement de la classe

par contre dans une classe control il me semble que j'avais essayé et ca ne fonctionnait pas
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 public withevents texto as msform.textbox dim cl(3) as new classe1 private nuf as object function classification(usf) for i= 1 to 3 cl(i).texto=usf.controls("TextBox" & i):set cl(i).nuf=usf next end function ' private sub texto_change(....) '..... nuf.caption=texto.name end sub

re
bon ben pour le coup j'ai tout testé et dans une classe controls il faut le mettre en public et la ca fonctionne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public WithEvents comb As msforms.ComboBox
Public WithEvents forme As UserForm
Dim clBT(3) As New CLCOMBTEXTB
Public nuf As Object
Function classification(usf)
'Set nuf = usf' comme ceci il n'est pas accessible dans les evenement
For Each ctrl In usf.Controls
If TypeName(ctrl) = "ComboBox" Then
i = i + 1: Set clBT(i).comb = ctrl: Set clBT(i).forme = usf
Set clBT(i).nuf = usf ' marche pas plante !!!!
End If
Next
End Function
'
'evenement change de tout les combobox
Private Sub Comb_Change()
'textC.Value = comb.Value
MsgBox nuf.Caption
End Sub

je retiens
merci pour la piqure de rapel ;)