Discussion :

[seb360]

Bonjour à tous,

J'ai trouvé un petit code sympa pour créer des checkboxes dynamiquement et j'essai maintenant sans succès de leur attribuer une macro commune via un module de classe mais cela ne fonctionne pas !!! Est-ce possible avec des checkboxes sur une feuille ou uniquement pour des formulaires ?? Je n'ai aucun message d'erreurs, la macro du module de classe ne s'exécute pas !

Quelqu'un peut-il m'aider ?? J'ai joint un petit fichier...


Voici le code de la feuille de calcul :

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
Private Sub CommandButton1_Click()
 
Dim ThePlage As Range, Cell As Range
Dim Cbx As OLEObject
Dim L As Double, T As Double, W As Double, H As Double
 
Set ThePlage = ActiveSheet.Range("C2:C20")
 
For Each Cbx In ActiveSheet.OLEObjects
If TypeOf Cbx.Object Is MSForms.CheckBox Then
Cbx.Delete
End If
Next Cbx
 
For Each Cell In ThePlage
L = Cell.Left
T = Cell.Top
W = Cell.Width
H = Cell.Height
 
Set Cbx = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
Left:=L, Top:=T, Width:=W, Height:=H)
With Cbx
.Name = "CheckBox" & i
.Object.Font.Size = 8
.Object.Caption = ""
.Object.Value = False
End With
Next Cell
 
initcheck
 
End Sub

Celui du module :

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
Option Explicit
Public Collect As Collection
Public Sub initcheck()
'Gestion de la collection (liste) des checkboxes
Dim obj As OLEObject
Dim CO As Classe1
Set CO = Nothing
Set Collect = New Collection
 
For Each obj In Sheets("Interface").OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
Set CO = New Classe1
Set CO.Checkboxgroup = obj.Object
Collect.Add CO
End If
Next
End Sub

et celui du module de classe :

Code :

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

1
2
3
4
5
6
7
8
Option Explicit
Public WithEvents Checkboxgroup As MSForms.CheckBox
 
Private Sub CheckboxGroup_Click()
 
MsgBox "TOTO"
 
End Sub

Merci pour votre aide

[seb360]

C'est super bizarre !!
Si j'exécute une seconde fois la sub "initcheck" du module, ca fonctionne !! alors que celle-ci est déjà appelée à la fin de la sub qui créée les checkboxes !!

Pourquoi cela ne fonctionne-t-il pas ?? Je suis obligé de créer un second bouton pour relancer 'initcheck'...

Merci pour votre aide.

[Philippe Tulliez]

Bonjour,
Je vois déjà une chose curieuse dans ton code de la procédure CommandButton1_Click. La variable i n'est pas incrémentée donc tu crées 19 CheckBox portant le même nom.

Code :

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

1
2
3
4
5
6
With Cbx
.Name = "CheckBox" & i
.Object.Font.Size = 8
.Object.Caption = ""
.Object.Value = False
End With

[seb360]

Bonjour,

J'ai vu ce point ! J'y ai cru aussi mais non cela ne résoud pas mon problème... Prise de tête !
Ci-joint un nouveau fichier avec 2 boutons : l'un créé les cases à cocher et exécute la fonction initcheck et l'autre re-exécute la fonction initchek. Seulement après cette action la macro commune fonctionne !!

Merci pour votre aide

[Philippe Tulliez]

Bonjour,

Bonjour,
J'ai vu ce point ! J'y ai cru aussi mais non cela ne résoud pas mon problème... Prise de tête !
Ci-joint un nouveau fichier avec 2 boutons : l'un créé les cases à cocher et exécute la fonction initcheck et l'autre re-exécute la fonction initchek. Seulement après cette action la macro commune fonctionne !!
Merci pour votre aide

Je n'ai pas dit que le problème venait de là mais je signalais que c'était également un problème.
Il est clair que tu as peu de chance d'arriver à un résultat quelconque avec cette variable qui ne s'incrémente pas.
Un programme informatique c'est un peu comme un accident grave, cela arrive suite à une série d'erreurs humaines et en raison de défauts de conception.

[seb360]

Aille aille aille pas de réponse ?? Tanpis, je vais devoir envisager l'écriture de lignes de code pour chacune de ces petites checkboxes...

Dommage, ce module de classe aurait été très intéressant...