Ajout multiple Event Procedure

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:

---

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:

---

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

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.

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:

---

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

Code:

---

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

---

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".

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,

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 ?

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:

---

1 2 3 4 5

Function GetDcColor()   MsgBox Me.ActiveControl.BackColor   End Function

---

Domi2

*Moi, c'est ma suissitude

Salut Domi2,

Citation:

---

Moi, c'est ma suissitude

---

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

Mais cela nous écarte du sujet...

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

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

@Domi2

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

Citation:

---

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é.

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

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:

---

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:

---

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

---

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

Je ne comprend pas bien non plus le but.

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

Code:

---

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

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:

---

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:

---

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

Re-Bonjour ! j'ai réussi !!

Pour y arriver j'ai créer une Macro comme tu m'avait dit dès le début :aie:

j'ai transformé mon Private sub en Fonction puis au Form_Load j’affecte le nom de ma macro à tous les rectangles sur le Click()

merci mille fois
:lahola:

J'ai trouvé un code encore mieux pour ceux à qui sa peut être utile !!

je vais créer un post Contribuez ICI