Renvoyer tous les Captions de Checkboxes cochées vers une seule cellule

couscous21

XLDnaute Nouveau
Bonjour à tous,

Après de longues recherches, et devant mes connaissances parsemées de trous, j'ai besoin d'aide pour du VBA sur excel.

Pour faire simple, dans mon Userform, j'ai par exemples 50 checkbox, dont leur caption est :
1ère checkbox : "Patate"
2ème checkbox : "Tomate"
3ème checkbox : "Salade"
4ème checkbox : "Fromage"
....


On cocherai ce qu'on a mangé, par exemple, j'ai mangé un salade et du fromage,
et alors, les captions des checkboxes cochées renverraient toutes dans une seule cellule (A1), ce qui donnerai le repas pris par le client.
du coup, le texte renvoyé dans la cellule A1 serait : Salade et Tomate

on encore le texte renvoyé dans la cellule A1 serait : Salade, Fromage et Tomate

on encore le texte renvoyé dans la cellule A1 serait : Pizza, Chips, Courgettes et Tomate


(Pour avoir la cerise sur le gateau, le top du top : la virgule entre chaque Caption cochée, et le "et" juste avant le dernier Caption).

Merci d'avance chers amis !
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Renvoyer tous les Captions de Checkboxes cochées vers une seule cellule

Bonsoir Couscous, bonsoir le forum,

Essaie comme ça :

Code:
Private Sub CommandButton1_Click()
Dim CTRL As Control 'déclare la variable CTRL (ConTRôLe)
Dim T As String 'déclare la variable T (Texte)
Dim NB As Byte 'déclare la variable NB (NomBre)
Dim FIN As String 'déclare la variable FIN
Dim NC As Byte 'déclare la variable NC (Nombre de Caractères)

For Each CTRL In Me.Controls 'boucle sur tous les contrôle de l'UserForm
    If TypeOf CTRL Is MSForms.CheckBox Then 'condition : si le contrôle est une CheckBox
        'si le contrôle est coché, définit le texte T
        '(si T est vide, la [Caption] du contrôle, sinon, T + une virgule + un espace + la [Caption] du contrôle)
        If CTRL.Value = True Then T = IIf(T = "", CTRL.Caption, T & ", " & CTRL.Caption)
    End If 'fin de la condition
Next CTRL 'prochain contrôle de la boucle
NB = UBound(Split(T, ", ")) 'récupère le nombre blocs-texte séparés par une virgule dans T
If NB = 0 Then Range("A1").Value = T: Exit Sub 'si NB vaut 0, place T dans la cellule A1 et sort de la procédure
FIN = Split(T, ", ")(NB) 'récupère le dernier bloc-texte de T
NC = Len(FIN) + 2 'récupère le nombre de caractères du dernier bloc-texte de T
T = Left(T, Len(T) - NC) & " et " & FIN 'redéfinit T en remplaçant la dernière virgule par " et "
Range("A1").Value = T 'place T dans la cellule A1
Unload Me 'vide et ferme l'UserForm
End Sub
 

Bebere

XLDnaute Barbatruc
Re : Renvoyer tous les Captions de Checkboxes cochées vers une seule cellule

bonjour couscous
bienvenue,voilà avec , et et
Code:
Dim n As Byte

Private Sub CommandButton1_Click()
    Dim i As Byte, m As String

    For i = 1 To n
        If Me("CheckBox" & i) Then
            If i < n Then
                m = m & Me("Checkbox" & i).Caption & ", "
            Else
                m = Left(m, Len(m) - 1) & " et " & Me("Checkbox" & i).Caption

            End If
        End If
    Next i
    Range("A1") = m
    For i = 1 To n
        Me("CheckBox" & i) = False
    Next i

End Sub

Private Sub UserForm_Initialize()
'compte
    For Each ctrl In Controls
        If TypeName(ctrl) = "CheckBox" Then n = n + 1
    Next ctrl

End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Renvoyer tous les Captions de Checkboxes cochées vers une seule cellule

Bonsoir le fil, bonsoir le forum,

Bonsoir Bebere,
ton code plante si on ne coche que la dernière CheckBox de la liste.
De plus, il ne mettra un et que si toutes les CheckBoxes sont cochées.

Il me semble avoir compris que Couscous voulait un et à la fin même si ce n'était pas la dernière CheckBox. Par exemple, 10 CheckBoxes, on coche la 5, la 7 et la 9.
On obtient en A1 : [Caption].CheckBox5, [Caption].CheckBox7 et [Caption].CheckBox9...
 

couscous21

XLDnaute Nouveau
Re : Renvoyer tous les Captions de Checkboxes cochées vers une seule cellule

Excellent, j'ai pu adapter le code de Robert à Ma sauce.

Le code de Bebere n'a pas fonctionné, le "ctrl" n'a apparemment pas été reconnu par Excel.

Merci à tous les deux. Sujet Résolu !
 

Bebere

XLDnaute Barbatruc
Re : Renvoyer tous les Captions de Checkboxes cochées vers une seule cellule

bonjour Couscous,Robert,le forum
le code que j'ai mis n'est pas complet
j'en ai marre de ne pas avoir de retour(trop souvent)
comme ceçi j'en ai un ,merçi à toi
 

couscous21

XLDnaute Nouveau
Re : Renvoyer tous les Captions de Checkboxes cochées vers une seule cellule

J'ai une requête en prologement.

Lorsqu' aucune de mes 120 Checkboxes n'est cochée, et que l'on clique sur CommandButon 1, ça lance le débogage.
En effet, la ligne suivante est impossible si rien n'est coché :
NB = UBound(Split(t, ", ")) 'récupère le nombre blocs-texte séparés par une virgule dans T

Je cherche à lancer une MSGBOX du genre ("Vous n'avez rien sélectonné !) qui se lancerai avec :
If toutes les checkboxes.Value = False Then
MsgBox "Vous n'avez rien sélectionné !"
End If
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Renvoyer tous les Captions de Checkboxes cochées vers une seule cellule

Bonjour le fil, bonjour le forum,

j'ai rajouté la ligne :

Code:
If T = "" Then MsgBox "Vous n'avez rien sélectionné !": Exit Sub 'si T est vide message, sort de la procédure
Le code :
Code:
Private Sub CommandButton1_Click()
Dim CTRL As Control 'déclare la variable CTRL (ConTRôLe)
Dim T As String 'déclare la variable T (Texte)
Dim NB As Byte 'déclare la variable NB (NomBre)
Dim FIN As String 'déclare la variable FIN
Dim NC As Byte 'déclare la variable NC (Nombre de Caractères)

For Each CTRL In Me.Controls 'boucle sur tous les contrôle de l'UserForm
    If TypeOf CTRL Is MSForms.CheckBox Then 'condition : si le contrôle est une CheckBox
        'si le contrôle est coché, définit le texte T
        '(si T est vide, la [Caption] du contrôle, sinon, T + une virgule + un espace + la [Caption] du contrôle)
        If CTRL.Value = True Then T = IIf(T = "", CTRL.Caption, T & ", " & CTRL.Caption)
    End If 'fin de la condition
Next CTRL 'prochain contrôle de la boucle
If T = "" Then MsgBox "Vous n'avez rien sélectionné !": Exit Sub 'si T est vide message, sort de la procédure
NB = UBound(Split(T, ", ")) 'récupère le nombre blocs-texte séparés par une virgule dans T
If NB = 0 Then Range("A1").Value = T: Exit Sub 'si NB vaut 0, place T dans la cellule A1 et sort de la procédure
FIN = Split(T, ", ")(NB) 'récupère le dernier bloc-texte de T
NC = Len(FIN) + 2 'récupère le nombre de caractères du dernier bloc-texte de T
T = Left(T, Len(T) - NC) & " et " & FIN 'redéfinit T en remplaçant la dernière virgule par " et "
Range("A1").Value = T 'place T dans la cellule A1
Unload Me 'vide et ferme l'UserForm
End Sub
 

Statistiques des forums

Discussions
311 725
Messages
2 081 944
Membres
101 849
dernier inscrit
florentMIG