Boucle et messages - Formulaire VBA

Bonjour à tous,

Je galère avec ce fichier. J'ai apporté quelques modifications et j'obtiens ce message sans aucune possibilité d'ajout alors que ma base de donnée est incomplète. Voici le code que j'utilise afin de saisir dans ma base :

'Inscrire dans la source

Private Sub Boutoninscrire_Click()

  If Range("Tableau46").Rows.Count < 19 Then

        Sheets("Inscriptions").Activate

        If Bassins = "" Or ChoixRLS = "" Or NUM = "" Or Choixhrs = "" Or nomprenom = "" Or choixlangue = "" Or TextBox6 = "" Or datenaissance = "" Or typedemande = "" Or IntPivot = "" Or Intautres = "" Or profilintervention = "" Or profilisosmaf = "" Or oemcdate = "" Or raisoncode = "" Then

            MsgBox ("Tous les champs de sont pas correctement remplis")
            Exit Sub
        End If

        With Sheets("Inscriptions")
            .Unprotect Password:="CES"

            If Sheets("Inscriptions").Range("B3") = "" Then
                Sheets("Inscriptions").Range("B3") = Bassins
            Else
                'Sheets("Inscriptions").ListObjects(1).ListRows.Add
                'Insérer à la dernière ligne

                MsgBox Range("Tableau46").Rows.Count, vbOKOnly + vbInformation, 
               "COMFIRMATION"

                Range("B3").End(xlDown).Offset(1, 0).Select

                    ActiveCell = Bassins.Value
                    ActiveCell.Offset(0, 1).Value = ChoixRLS
                    ActiveCell.Offset(0, 2).Value = NUM
                    ActiveCell.Offset(0, 3).Value = Format(Me.Choixhrs.Value, 
                  "hh:mm:ss")
                    ActiveCell.Offset(0, 4).Value = nomprenom
                    ActiveCell.Offset(0, 5).Value = choixlangue
                    ActiveCell.Offset(0, 6).Value = TextBox6
                    ActiveCell.Offset(0, 7).Value = datenaissance
                    ActiveCell.Offset(0, 8).Value = typedemande
                    ActiveCell.Offset(0, 9).Value = IntPivot
                    ActiveCell.Offset(0, 10).Value = Intautres
                    ActiveCell.Offset(0, 11).Value = profilintervention
                    ActiveCell.Offset(0, 12).Value = profilisosmaf
                    ActiveCell.Offset(0, 13).Value = Format(Me.oemcdate.Value, 
                  "YYYY/MM/DD")
                    ActiveCell.Offset(0, 14).Value = raisoncode

                MsgBox "Les informations ont été ajoutés à la base de donnée", 
                vbOKOnly + vbInformation, "COMFIRMATION"

            End If
            .protect Password:="CES"

            End With

            Else
            MsgBox "Tableau complet", vbOKOnly + vbInformation, 
           "COMFIRMATION"
            End If

End Sub

J'ajoute le fichier en pièce jointe afin de faciliter la visualisation. En clair, il manque quelque chose et j'essaie différentes options mais sans résultat.

Une solution ?

Merci

Bonjour

Pas de ligne vide dans un tableau...

En VBA les lignes vides ne servent à rien

Pourquoi 18 enregistrements ?

Par contre l(alignement est important ....(question de clarté)

Ci joint ma solution

A+ François

C'est nickel ! Le formulaire est fantastique et de loin préférable. J'aimerais que les gens ne puissent entrer plus de 20 inscriptions. Le message est clair lorsque le tableau en plein mais il est encore possible d'y inscrire des gens. Pour répondre à la question, j'ai tenté de fermer la boucle avec le code suivant :

If Range("T_inscription").Rows.Count >= 19 Then 

Il est possible que mon code ne soit pas valable ?

Dès que tu aura 18 enregistrements tu ne pourra plus en ajouter....

A+ François

Merci !

Bonjour Fanfan,

En le testant à nouveau, j'arrive à insérer les données dans ma base lorsque tous les champs du formulaire sont remplis.

Devrais ajouter une condition à l'ouverture du formulaire ? Je ne suis pas certaine de cette démarche ... Qu'en pensez-vous ?

Va falloir trouver quelqu'un d'autre ou attendre... je pars en vacance demain matin... lol

A+ François

Je vous souhaite de belles vacances !!!

Bonjour à tous,

J'ai essayé de nouveau avec la boucle suivante :

If Range("T_inscription").Rows.Count <= 19 Then 
msg box "" 

Je n'arrive pas à bon port. Une personne ici saurait m'indiquer ce qu'il me manque ? Le fichier est en pièce jointe dans les conversations. J'ai repris celui de fanfan que je trouve beaucoup plus convivial.

Merci à vous tous !

Bonjour

Après le 20ème usagers inscription impossible

A+ François

Bonjour,

pourquoi ne pas faire le test avant l'ouverture du USF ?

Sub OuvreFormulaire() 'Afficher le formulaire
    If Range("T_inscription").Rows.Count > 19 Then
        MsgBox "Formulaire complet, ouverture stoppée, veuillez svp supprimer un usager"
    Else
        FormulaireInscription.Show
    End If
End Sub

plus un code à mettre sur la feuille pour éviter de rajouter "en direct" une ligne au delà de 20 :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("T_inscription").Rows.Count > 19 Then
        Application.EnableEvents = False
        Application.Undo
        Target.Value = ""
        Application.EnableEvents = True
    End If
End Sub

@ bientôt

LouReeD

Bonsoir LouReed,

Merci pour l'avancement. J'ai dans l'idée qu'il me manque quelque chose dans le code

Sub OuvreFormulaire() 'Afficher le formulaire

    If Range("T_inscription").Rows.Count > 19 Then
            MsgBox "Formulaire complet, veuillez supprimer un ou des usagers"
    Else
            FormulaireInscription.Show

    End If

End Sub

Car j'obtiens bien le MsgBox cependant lorsque je supprime des usagers et je que j'en obtiens moins de 19 je ne peux plus inscrire. Le code m'empêche d'inscrire à nouveau... c'est zarbi car j'ai bien mon else formulaireinscription.show ...

Merci pour votre aide !

Quel est votre mode de suppression ? Si la ligne du tableau "reste" malgré l'absence de données elle est compté dans les 20, la suppression dois se faire "dans le tableau", clic droit - supprimer ligne.

Si c'est par code alors il faut utiliser les instruction correspondant aux tableaux structurés !

@ bientôt

LouReeD

Voilà, ceci fonctionne :

Sub Supprimer()
'
' Supprimer Macro
Dim i As Integer
    Dim SupprimeLigne As String, Cel As Range
    SupprimeLigne = InputBox("Veuillez entrer le nom, prénom à supprimer", "SUPPRESSION")
    Set Cel = [T_inscription].Find(SupprimeLigne)
    ActiveSheet.ListObjects(1).ListRows(Cel.Row - [T_inscription].Row + 1).Delete
End Sub

Mais je crois qu'il y a plus simple que la soustraction +1... Je suis fatigué !
On peut même y ajouter un test de validité de la recherche avant l'instruction "delete" avec un :
If Cel is nothing then exit sub

@ bientôt

LouReeD

une autre possibilité, elle parait plus propre... mais bon c'est une question de goût ! Elle a l'avantage de ne cibler que la colonne 5 de votre tableau celle des noms prénoms, car l'autre code cherche dans toutes les cellules et pour peu que sur la ligne "LouReeD" il y ait une information sur prénom2 Nom5 et bien la ligne LouReeD serait ciblée pour la suppression si elle était trouvée avant l'autre !

Sub LRD()
    Dim Col, SupprimeLigne, I
    Set Col = [T_inscription].ListObject.ListColumns(5).DataBodyRange
    SupprimeLigne = InputBox("Veuillez entrer le nom, prénom à supprimer", "SUPPRESSION")
    For I = 1 To Col.Rows.Count
        If Col(I, 1) = SupprimeLigne Then [T_inscription].ListObject.ListRows(I).Delete: Exit For
    Next
End Sub

Ici cela cible la colonne 5, mais pour plus de précision vous pouvez mettre entre guillemet l'intitulé de l'entête de la colonne, comme cela vous pouvez la déplacer dans le tableau, le code fonctionnera toujours (sauf si vous modifiez l'intitulé...).

Moi je la préfère car elle s'appelle LRD !

@ bientôt

LouReeD

Je suis fatiguée moi aussi mais la solution semble nickel je vais l'essayer demain

Merci et à bientôt

Annie

Je reviens afin de confirmer que les codes pour suppression fonctionnent nickel comme prévu. J'ai toujours mon message de fichier complet qui ne me permet pas d'inscrire lorsque le tableau contient 19 lignes. Je supprime rien n'y fait. J'ai essayé d'ajouter ceci dans mon module à l'ouverture du fichier :

If Range("T_inscription").Rows.Count <= 19 Then
            MsgBox "Vous pouvez ajouter un usager"
    Else
            FormulaireInscription.Show

Je suis toujours sur l'impression qu'il me manque quelque chose et je n'arrive pas à trouver..

Bonsoir,

votre premier fichier fourni modifié avec les test de saisie en direct :

@ bientôt

LouReeD

Alors là ! En supprimant la colonne plutôt tout fonctionne c'est bien ça ?

Je suis vraiment très reconnaissante de ce travail. C'est très sympa ce que vous avez fait.

Épatée.

Annie

Bonsoir,

j'avoue ne pas comprendre ceci : En supprimant la colonne plutôt tout fonctionne c'est bien ça ?

Sinon je pense que votre fichier fourni, modifié avec les codes fournis fonctionne pour ce qui est demandé : ajout de données par formulaire, ne pas lancé le formulaire si déjà 20 données inscrites, suppressions des données inscrites "en dur" directement sur la feuille si plus de 20 données.

@ bientôt

LouReeD