Checkbox et evenements dynamiques [Résolu]

Signaler
Messages postés
4
Date d'inscription
mardi 7 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2005
-
Messages postés
4
Date d'inscription
mardi 7 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2005
-
Bonjour à tous,

Novice du VBA, j'utilise Excel version 2002 et je tente désespérément de créer des checkbox et leur événement "click" associé de façon dynamique dans une macro VBA. En effet selon les cas je peux avoir besoin d'une jusqu'à N checkbox.

J'ai donc inséré dans un module du code qui génère des chekbox et leur événement click sur une feuille excel. Les checkbox se créent bien mais je bute sur les événements.

Excel semble créer automatiquement un événement click lié à une check box générée dynamiquement (voir list box au dessus du code qui répertorie les fonctions d'une worksheet). J'ai donc utilisé une première méthode :

-Méthode 1
ActiveWorkbook.VBProject.VBComponents("Feuil1").CodeModule.ProcBodyLine("CB" & i & "_Click", vbext_pk_Proc)
Cette fonction est sensée me retourner la ligne de l'occurrence de la fonction « CB[i]_click() » (histoire d'insérer mon code ensuite). Cette fonctionne me retourne rien au premier lancement de la macro. Elle me retourne quelque chose uniquement si je vais dans la fameuse listbox, sélectionne par ex CB1_click() pour la faire apparaître en dessous dans le code et relance la macro. Pour 100 check box ça risque d'être long !

-Méthode 2 (Plan B) ActiveWorkbook.VBProject.VBComponents("Feuil1").CodeModule.CreateEventProc("CB" & i & "_Click", Obj1.Name)
Cette fonction crée un événement lié à un objet. Je génère une erreur « 440, gestionnaire d'événement non valide ».

Désolé d'avance si mes explications sont longues et confuses. Je n'hésiterai pas à clarifier les points obscurs.

Grand merci d'avance à tous ceux qui peuvent m?aider : une solution, une fonction, une piste, ou même un encouragement car là j'en peux plus !

Mais surtout s'il vous plait dites moi que c'est possible ! ;-)

Code :

ActiveSheet.OLEObjects.Delete
Dim i As Integer
Dim DebutCode As Integer

For i = 1 To 10

Dim Obj1 As OLEObject

L = Range("C" & i).Left + 3
T = Range("C" & i).Top + 3
W = 10
H = 10

Set Obj1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, Left:=L, Top:=T, Width:=W, Height:=H)

Obj1.Name = "CB" & i
Obj1.Object.Value = True

DebutCode = ActiveWorkbook.VBProject.VBComponents("Feuil1").CodeModule.CreateEventProc("CB" & i & "_Click", Obj1.Name)
'DebutCode = ActiveWorkbook.VBProject.VBComponents("Feuil1").CodeModule.ProcBodyLine("CB" & i & "_Click", vbext_pk_Proc)
ActiveWorkbook.VBProject.VBComponents("Feuil1").CodeModule.InsertLines DebutCode + 1, "MsgBox ""YO!"""

Next i

1 réponse

Messages postés
4
Date d'inscription
mardi 7 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2005

La soluce:

Sub Test()
Dim I As Integer
Dim F As Worksheet
Dim Code$

'Application.ScreenUpdating = False

Set F = ActiveSheet

F.OLEObjects.Delete
For I = 1 To 10
Code = "msgbox ""yoyo"" & " & I & ""
SupprUneProc ThisWorkbook, F.CodeName, "CB" & I & "_click"
AjouterUnObj F, "forms.checkbox.1", Array("CB" & I, F.Range("C" & I).Left + 3, F.Range("C" & I).Top + 3, 10, 10, "")
AjouterProcEven ThisWorkbook, F.CodeName, "Click", "CB" & I, Code
Next I
SendKeys "%{F11}" 'pour fermer VBE

'Application.ScreenUpdating = True

End Sub

Sub AjouterUnObj(F As Worksheet, Objet$, Optional T)
Dim B As OLEObject
Set B = F.OLEObjects.Add(Objet)
If IsMissing(T) Then Exit Sub
With B
.Name = T(0)
.Left = T(1)
.Top = T(2)
.Width = T(3)
.Height = T(4)
.Object.Caption = T(5)
'.Object.Value = True
End With
End Sub

Sub AjouterProcEven(C As Workbook, NomModule$, Evenement$, Objet$, Code$)
With C.VBProject.VBComponents(NomModule).CodeModule
.InsertLines .CreateEventProc(Evenement, Objet) + 1, Code
End With
End Sub

Sub SupprUneProc(C As Workbook, NomModule$, NomProc$)
On Error Resume Next
With C.VBProject.VBComponents(NomModule).CodeModule
.DeleteLines .ProcStartLine(NomProc, 0), .ProcCountLines(NomProc, 0)
End With
End Sub
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 179 internautes nous ont dit merci ce mois-ci