Ajout multiple Event Procedure

**robyseb** · 15/08/2012, 01h54

Bonjour !

j'ai créer un formulaire avec 70 rectangle sur lequel je voudrait insérer une procédure sur le On_Click.

j'ai ne sait pas trop comment m'y prendre pour affecter les procédure à un évènement par exemple ;

Code :

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

1
2
3
4
5
6
Private sub Form_Load()
    ' parcours l'entete de formulaire
    For Each ctrl In Form.Section(acDetail).Controls
        If TypeOf ctrl Is Rectangle Then
            ' on active l'événement
            ctrl.OnClick = "[Event Procedure]"

j'aurait public sub Couleur1_Click() à Public Sub Couleur70_Click()

Mon Évènement serait :

Code :

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

1
2
3
Private Sub Couleur1_Click()
GetDcColor 'Une Fonction dans un module externe !
End Sub

Je suis un peu perdu j'espère avoir de l'aide merci

**ClaudeLELOUP** · 15/08/2012, 10h08

Bonjour,

J'ai compris que tu voulais éviter de devoir coder septante* fois la même chose.

Tu pourrais y arriver simplement comme ceci :

- créer une macro qui exécute ton code ;
- affecter cette macro à l'événement clic de tes rectangles : il suffit de les sélectionner tous et de saisir le nom de la macro dans la propriété "Sur clic".

* pas pu résister à exprimer ma belgitude.

**robyseb** · 15/08/2012, 14h00

Bonjour Claude !

Exactement Mais le principale est que si je fait des changement ils seront répercuté à chaque ouverture !!

Si on reprend l'exemple que j'ai mit : Le fait de mettre seulement

Code :

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

GetDcColor

Dans l'Évenement ne reviendrait pas au même que de créer une macro et de l'affecter à la procédure Click().

Si tu a une idée comment rajouter ce qu'il me manque à mon code je suis preneur

Code :

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

1
2
3
4
5
6
7
Private sub Form_Load()
    ' parcours l'entete de formulaire
    For Each ctrl In Form.Section(acDetail).Controls
        If TypeOf ctrl Is Rectangle Then
            ' on active l'événement
            ctrl.OnClick = "[Event Procedure]"
End Sub

**ClaudeLELOUP** · 15/08/2012, 15h28

Je ne comprends pas le résultat que tu veux obtenir.

Explique avec des mots (pas avec du code !) ce que tu veux faire.

Poste le code de la fonction "GetDcColor".

**robyseb** · 15/08/2012, 15h46

Bonjour !

J'ai créer un formulaire que j'ai appeller ColorPicker.

donc j'ai 70 rectangle de couleur, donc lorsque je clique sur l'un d'eux la fonction GetDcColor récupère la couleur sous le pointeur au moment de l'appel de la fonction !!

Donc je désire à l'ouverture du formulaire créer une routine qui va affecter à chaque rectangle sur le rectangle_Click() l'Appel de GetDcColor. À moin qu'il y est une autre méthode, je pensait que se serait la façon de faire.

Peu importe le contenu de la fonction moi tous ce que je désirerai faire c'est de l’appeler au moment du clic !!

cordialement,

**ClaudeLELOUP** · 15/08/2012, 16h29

Pour l'instant, j'ai cru comprendre que tu as 70 rectangles.
Ces rectanges ont chacun une couleur différente.
La code de cette couleur se trouve dans la propriété "Couleur fond" de chaque rectangle.
Par exemple 255 pour rouge, 65535 pour jaune, 16777215 pour blanc.

Que veux-tu faire avec ce formulaire ?

**Domi2** · 15/08/2012, 17h18

Bonjour,

Si j'ai bien compris, je ne me casserais pas la tête et je ferais comme le dit Claude.

En mode modification de ton formulaire, tu sélectionnes tes septante* rectangles et dans l'événement Sur clic, tu mets simplement =GetDcColor().

Et dans le module du formulaire, ta fonction GetDcColor :

Code :

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

1
2
3
4
5
Function GetDcColor()
 
    MsgBox Me.ActiveControl.BackColor
 
End Function

Domi2

*Moi, c'est ma suissitude

**ClaudeLELOUP** · 15/08/2012, 17h38

Salut Domi2,

Moi, c'est ma suissitude

"suissitude" ne figure pas dans le dictionnaire. Par contre, le LaRousse 2013 mentionne "belgitude"...

Mais cela nous écarte du sujet...

**Domi2** · 15/08/2012, 17h43

"Belgitude", ça qualifie un pays sans gouvernement ?

Oui, bon effectivement, on s'écarte du sujet

**ClaudeLELOUP** · 15/08/2012, 18h05

@Domi2

J'ignore si c'est propre à Access2000 que j'utilise mais :

dans l'événement Sur clic, tu mets simplement =GetDcColor().

C'est refusé : Access attend un nom de macro ou une procédure.

Et un rectangle cliqué n'est pas le contrôle actif !

Pour ce deuxième point, il suffit de remplacer les rectangles par des zones de texte et le tour est joué.

**Domi2** · 15/08/2012, 18h21

Tu as bien créé une fonction et pas une procédure ?

Pour le rectangle, effectivement, j'ai aussi testé avec une zone de texte.

Domi2

**robyseb** · 15/08/2012, 18h28

Bonjour à vous 2 !

j'ai tenté vos solutions mais ca ne fonctionne pas ...

Donc pour résumé, ma solution qui est d'affecté à chaque rectangle soit "sur Click" une procédure possèdant mon sub à appeller soit GetDcColor comme ceci :

Code :

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

1
2
3
Private Sub Couleur1_Click()
GetDcColor
End Sub

je tente de créer une routine avec une boucle qui à l'ouverture de mon formulaire créera celle-ci

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private sub Form_Load()
dim I as integer
    ' parcours l'entete de formulaire
    For Each ctrl In Form.Section(acDetail).Controls
        If TypeOf ctrl Is Rectangle Then
            ' on active l'événement
            for I = 1 to 70
             ctrl = Couleur & I
            ctrl.OnClick = "[Event Procedure]"
            next
End Sub

**ClaudeLELOUP** · 15/08/2012, 18h38

@Domi2

Mea culpa : avec une fonction dans le module du formulaire, c'est OK.

@robyseb

Toujours pas compris ce que tu veux faire. Explique avec des mots ton but au lieu de nous montrer ton code qui ne fonctionne pas !

**Domi2** · 15/08/2012, 18h59

Je ne comprend pas bien non plus le but.

Bien sûr, on peut affecter dynamiquement la fonction à l'événement Sur clic :

Code :

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

ctrl.OnClick = "=GetDcColor()"

Mais après ? Tu n'es pas plus avancé que si tu saisis en dur dans les propriétés du contrôle. Il te faut encore récupérer la couleur de fond du rectangle actif. Et si c'est simple avec une zone de texte...

Domi2

**robyseb** · 15/08/2012, 19h08

Bonjour et merci

Justement j'ai remarqué ne pas vous avoir montré que la fonction récupère la couleur de fond .. la voici :

dans un module à part j'ai ceci :

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
Option Compare Database
Option Explicit
'GetCursorPos: renvoie la position de la souris sur l'écran.
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'GetDC: Renvoie le Handle d'un Contexte d'Affichage hDC (Handle of Device Context)
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
'GetPixel: renvoie la couleur du pixel en fonction des coordonnées spécifiées (X et Y)
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, _
                    ByVal Y As Long) As Long
 
 
'Coordonnées d'un point de l'écran.
Type POINTAPI
        X As Long
        Y As Long
End Type
 
Public Function GetDcColor() As Double
Dim DeskHdc As Long
Dim Pxy As POINTAPI
 
    'GetDC(0): Pour récupérer le hDC de l'écran
    DeskHdc = GetDC(0)
    'Récupére la position du curseur de la souris
    GetCursorPos Pxy
    'La fonction renvoie la couleur à l'emplacement spécifié
    GetDcColor = GetPixel(DeskHdc, Pxy.X, Pxy.Y)
End Function

et dans le module du formulaire j'ai ceci :

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
Public Sub ColorPicker()
 
Dim Rouge As Integer, Vert As Integer, Bleu As Integer
    Dim Couleur As Long
 
    'affiche la couleur correspondant à l'emplacement du curseur de la souris
    Me.RectangleCouleur.BackColor = "&H" & Hex(GetDcColor)
    Couleur = Me.RectangleCouleur.BackColor
 
    '--- Convertit la couleur au format RGB -------
    Rouge = Int(Couleur Mod 256)
    Vert = Int((Couleur Mod 65536) / 256)
    Bleu = Int(Couleur / 65536)
    '------------------------------------------------
 
 
    '--- Affiche les codes RGB dans les TextBox -----
    Me.RGB1 = Rouge
    Me.RGB2 = Vert
    Me.RGB3 = Bleu
    '------------------------------------------------
End Sub

Premièrement je me suis trompé dans la retranscritpion ici .. donc la procédure à récupérer est "ColorPicker" et le but n'est pas seulement de capturer la couleur de fond mais aussi de spécifier le Code RGB de cette couleur affiché dans 3 textbox !!

j'ai récupéré cette fonction dans le Post ICI