Transférer Données listbox Multiselect (Userform) dans Base de données

Bonjour,

nouveau dans le monde VBA et sur ce forum, je fais appel à votre expertise.(Je suis encore sous XLS 2007)

J'ai créé un userform de saisie pour alimenter un tableau XLS.

En phase de finalisation, j'ai réalisé qu'il me fallait une multi-sélection sur une combobox que j'ai donc transformée en listbox.

Mon objectif :

1/Pouvoir sélectionner 1 ou plusieurs choix parmi une liste évolutive (mise donc sous forme de tableau dans ma feuille "LD")

2/Transférer ses choix dans une seule cellule (Titi, Tata, Toto)

Je bloque sur cette 2eme étape, voici où j'en suis :

=> CBOX initialement créée remplacée par Listbox1 puis paramétrée

=> Remplacement du nom CBOX par Listbox1 dans toutes les macro concernées

Lorsque je saisie mon userform, toutes les données s'affichent dans ma base de donnée à l'exception de la cellule concernée (Type de suivi)

Voici en mon fichier, 1000 mercis par avance à ceux qui pourront m'aider dans mon initiation.

1) Supprimez des Références "Manquant : Microsoft Calendar 2007"

2) Dans la procédure Initialize de l'UF, remplacez "clear" par "0" (Feuil2.Range("B1:F1").Interior.ColorIndex = Clear)

3) essayez ceci :

Private Sub BTOSAVE_Click()
        Dim typeSuivi As String
        Dim i As Byte
    ' On mémorise les sélections        
        typeSuivi = ""
        For i = 0 To Me.ListBox1.ListCount - 1
            If Me.ListBox1.Selected(i) = True Then typeSuivi = typeSuivi & Me.ListBox1.List(i) & " | "
        Next i
        typeSuivi = Left(typeSuivi, Len(typeSuivi) - 3)

    'On teste que les contrôles ont bien été saisie        
        If Len(Me.TXTNOM) = 0 Then
            Me.lblmessage = "Veuillez saisir le nom de l'élève."
            Me.TXTNOM.SetFocus
        ElseIf Len(Me.TXTPRENOM) = 0 Then
            Me.lblmessage = "Veuillez saisir le prénom de l'élève."
            Me.TXTPRENOM.SetFocus
        ElseIf Len(Me.TXTNAISS) = 0 Then
            Me.lblmessage = "Veuillez saisir la date de naissance de l'élève."
            Me.TXTNAISS.SetFocus
        ElseIf Len(Me.CBOECOLE) = 0 Then
            Me.lblmessage = "Veuillez sélectionner l'école de rattachement de l'élève."
            Me.CBOECOLE.SetFocus
        ElseIf Len(Me.CBOCLASSE) = 0 Then
            Me.lblmessage = "Veuillez sélectionner la classe de l'élève."
            Me.CBOCLASSE.SetFocus
        ElseIf Len(Me.CBOENSEIGN) = 0 Then
            Me.lblmessage = "Veuillez sélectionner le nom de l'enseignant en charge de l'élève."
            Me.CBOENSEIGN.SetFocus
        ElseIf Len(Me.CBOCENTRE) = 0 Then
            Me.lblmessage = "Veuillez sélectionner le centre de soin."
            Me.CBOCENTRE.SetFocus
        ElseIf Len(Me.ListBox1) = 0 Then
            Me.lblmessage = "Veuillez sélectionner le type de suivi de l'élève."
            Me.ListBox1.SetFocus
        ElseIf Len(Me.TXTINTERV) = 0 Then
            Me.lblmessage = "Veuillez saisir le nom de l'intervenant."
            Me.TXTINTERV.SetFocus
        ElseIf Len(Me.CBOSANTE) = 0 Then
            Me.lblmessage = "Veuillez sélectionner le type de problème de santé."
            Me.CBOSANTE.SetFocus
        ElseIf Len(Me.CBOGROUPE) = 0 Then
            Me.lblmessage = "Veuillez sélectionner le numéro de groupe de suivi de l'élève."
            Me.CBOGROUPE.SetFocus
        ElseIf Len(Me.CBOMAINTIEN) = 0 Then
            Me.lblmessage = "Veuillez sélectionner la classe de maintien de l'élève."
            Me.CBOMAINTIEN.SetFocus
        Else       'Si tous les champs sont complet Alors on peut sauvegarder la source
            'On cherche la prochaine ligne vide de la source
            Feuil2.Activate
            Feuil2.Range("A1048576").End(xlUp).Offset(1, 0).Select
            'On affecter les données du formulaire dans la source
            If ActiveCell.Offset(-1, 0) = "CODE ENFANT" Then
                ActiveCell = 1
            Else
                ActiveCell = ActiveCell.Offset(-1, 0) + 1
            End If
            ActiveCell.Offset(0, 1) = Me.TXTNOM
            ActiveCell.Offset(0, 2) = Me.TXTPRENOM
            ActiveCell.Offset(0, 3) = CDate(Me.TXTNAISS)
            ActiveCell.Offset(0, 5) = Me.CBOECOLE
            ActiveCell.Offset(0, 6) = Me.CBOCLASSE
            ActiveCell.Offset(0, 7) = Me.CBOENSEIGN
            ActiveCell.Offset(0, 8) = Me.CBOCENTRE
            ActiveCell.Offset(0, 9) = typeSuivi                    ' La liste calculée au début **************************
            ActiveCell.Offset(0, 10) = Me.TXTINTERV
            ActiveCell.Offset(0, 11) = Me.CBOSANTE
            ActiveCell.Offset(0, 12) = Me.CBOGROUPE
            ActiveCell.Offset(0, 13) = Me.CBOMAINTIEN
            'On vide le formulaire pour une prochaine saisie
            Call BTO_ANNULER_Click
            Unload Me
            Feuil2.Activate
        End If
End Sub

Merci 1000 fois OPTIMIX pour ton retour express avec LA résolution à mon pb sur lequel j'ai passé 24 h!

Je vais pouvoir suivre le rugby en toute sérénité!

Impatient de suivre ma formation VBA pour pouvoir à terme essayer d'apporter mon aide sur ce forum.

Encore merci!

J'espère que l'essai inscrit puis refusé aux Samoa ne vous sera pas resté en travers de la gorge. Avant d'inscrire ce "19" fatidique, les organisateurs auraient dû attendre.

Votre code est quand même à revoir : essayez d'entrer un espace dans la zone de saisie "NOM", il sera valide car la longueur vaudra 1. Il vaudrait mieux écrire :

If Trim(TXTNOM) = "" then

au lieu de :

If Len(TXTNOM) = 0

De même, essayez d'entrer 24/12/199 dans la date de naissance, elle sera validée mais provoquera une erreur. Et malgré l'erreur, le code de l'enfant, ses nom et prénom seront enregistrés. C'est un problème de schéma fonctionnel : n'enregistrez rien tant que tout n'est pas au carré.

Bonne continuation.