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

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


Sujet :

VBA

  1. #1
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut encore un truc qui me rend dingue associer un evenemnt a l'userform dynamique dans la classe
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Sub test()
    Dim snap As New snapshot
    snap.create_ZoneCapture
    End Sub
    module classe nommé snapshot
    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
     
    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  2. #2
    Membre extrêmement actif
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 82
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Points : 12 422
    Points
    12 422
    Par défaut
    Bonjour Patrick
    regarde ce que tu as écrit ici :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
     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.
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro ******). Ne m'en proposez donc pas .

    ****** : Non, non ... un classeur .xlsx ne "peut" par exemple et entre autres pas contenir un activex (de surcroît invisible) , "bien sûr" ...

    Il est illusoire de penser que l'on saurait exprimer valablement et précisément en un langage (rigide) de développement ce que l'on peine à exprimer dans le langage naturel, bien plus souple.

  3. #3
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
    Dim snap As New snapshot
    Sub test()
    snap.Select_ZoneCapture
    End Sub

    module classe nommé "snapshot"
    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
     
    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
    Nom : demo.gif
Affichages : 318
Taille : 478,5 Ko
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  4. #4
    Membre extrêmement actif
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 82
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Points : 12 422
    Points
    12 422
    Par défaut
    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).
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro ******). Ne m'en proposez donc pas .

    ****** : Non, non ... un classeur .xlsx ne "peut" par exemple et entre autres pas contenir un activex (de surcroît invisible) , "bien sûr" ...

    Il est illusoire de penser que l'on saurait exprimer valablement et précisément en un langage (rigide) de développement ce que l'on peine à exprimer dans le langage naturel, bien plus souple.

  5. #5
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    Bonjour,

    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    'Module
    Option Explicit
     
    Dim snap As New snapshot
     
    Sub test()
    snap.Select_ZoneCapture
    End Sub
    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
    '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
    Cordialement,
    Franck

  6. #6
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    Bonjour franck

    essaie ton raisonnement dans un module classe

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    public withevents Nuf as object'pour un userform
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  7. #7
    Membre émérite
    Avatar de pijaku
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    1 814
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : Août 2010
    Messages : 1 814
    Points : 2 948
    Points
    2 948
    Billets dans le blog
    10
    Par défaut
    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.
    Cordialement,
    Franck

  8. #8
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  9. #9
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 379
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 379
    Points : 12 073
    Points
    12 073
    Billets dans le blog
    8
    Par défaut re
    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 : 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
    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Livebindings (encore) les trucs qui me rendent dingues
    Par SergioMaster dans le forum Composants FMX
    Réponses: 3
    Dernier message: 09/02/2016, 15h51
  2. Panier et produits, le truc simple qui me rend fou
    Par Corei7 dans le forum Doctrine2
    Réponses: 1
    Dernier message: 24/02/2013, 16h50
  3. SOS - Une Association Many-To-Many qui me rend fou
    Par NexoFlex dans le forum Hibernate
    Réponses: 2
    Dernier message: 30/06/2009, 19h09
  4. Script CMD qui ne rend pas la main
    Par ipeteivince dans le forum Autres Logiciels
    Réponses: 2
    Dernier message: 10/06/2005, 12h00
  5. [CR][.Net] Déploiement - Truc qui va pas la :D
    Par SoaB dans le forum SAP Crystal Reports
    Réponses: 1
    Dernier message: 10/05/2005, 10h36

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