Inserer la Caption de plusieur checkbox dans une seul cellule

[cpeens]

Bonjour à tous

je viens vous exposer un petit probleme

je recherche une solution grace à une boucle pour inserer le caption de plusieur checkbox dans une cellulle

exemple si checkbox1 et checkbox 3 sont cocher le caption de ces checkbox est incrementer dans la cellule A1 comme ceci Checkbox1,Checkbox3,

j'ai tenter ce petit code mais sa me met que le caption de la derniere checkbox

Sub Geste_Action()
Dimb As Long, NL As Long
NL = [Feuil1].Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
With Fiche
For b = 1 To 3
Worksheets("BDD").Cells(NL, 1).Value = .Controls("C12_" & b).Caption
Next b
End With
End Sub

pouvez vous m'aider svp merci

 

[Modeste]

Re : Inserer la Caption de plusieur checkbox dans une seul cellule

Bonjour cpeens,

À chaque passage dans la boucle, tu "écrases" le contenu de la cellule!
Essaye quelque chose comme

Sub Geste_Action()
Dim a As Long, b As Long, c As Long, d As Long, NL As Long
NL = [Feuil1].Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
With Fiche
ch = ""
For b = 1 To 3
If .Controls("C12_" & b) = True Then ch = ch & .Controls("C12_" & b).Caption & ", "
Next b
Worksheets("BDD").Cells(NL, 1) = Mid(ch, 1, Len(ch) - 2)
End With
End Sub

[Edit:] Merci Bernard!

 

[Dranreb]

Re : Inserer la Caption de plusieur checkbox dans une seul cellule

Bonjour Modeste
Le "= True" pour former une expression Boolean est de trop: .Controls("C12_" & b).Value est déjà Boolean.

 

[cpeens]

Re : Inserer la Caption de plusieur checkbox dans une seul cellule

Bonjour Modeste merci pour ta solution qui semble fonctionner parfaitement.
En revanche quand je coche aucune case sa me creer une erreur j'ai donc ajouter

 On Error Resume Next

a la ligne de code qui posait ce probleme.

Sub Geste_Action()
Dim a As Long, b As Long, c As Long, d As Long, NL As Long
NL = [Feuil1].Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
With Fiche
ch = ""
For b = 1 To 3
If .Controls("C12_" & b) = True Then ch = ch & .Controls("C12_" & b).Caption & ", "
Next b
[COLOR="#FF0000"]On Error Resume Next[/COLOR]Worksheets("BDD").Cells(NL, 1) = Mid(ch, 1, Len(ch) - 2)
End With
End Sub.

donc je pense sa posseras pas de soucis

en tous cas un grand merci à toi reste plus a tenter dans le projet initiale

encore merci