Créer une boucle for pour 2 lignes

Bonjour,

Afin de ne pas inscrire plus de deux lignes d'information identique dans mon formulaire, je doit baliser les codes avec ? De plus ce n'est qu'une partie du code apparemment.

L'analyse n'est pas facile.

Voici le code utilisé :

'Inscrire dans la source
Private Sub Boutoninscrire_Click()
 Dim rcell As Range 
 With Sheets("Inscriptions")
  .Activate
   If Range("T_inscription").Rows.Count > 19 Then
    MsgBox "Tableau complet", vbOKOnly + vbInformation, "COMFIRMATION"
    Unload Me
    Exit Sub
   End If  
  If Bassins = "" Or ChoixRLS = "" Or NUM = "" Or nomprenom = "" Or choixlangue = "" Or TextBox6 = "" Or datenaissance = "" Or typedemande = "" Or IntPivot = "" Or profilintervention = "" Or profilisosmaf = "" Or oemcdate = "" Then
   MsgBox ("Tous les champs ne sont pas correctement remplis")
   Exit Sub
  End If 
  .Unprotect Password:="CES"
   With .ListObjects("T_inscription")
    If .InsertRowRange Is Nothing Then '...................................si le tableau comporte des données
     Set rcell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1) '....1ère cellule vide (colonne 1 du tableau,nombre de lignes du tableau+1)
    Else
     Set rcell = .InsertRowRange.Cells(1) '................................1ère cellule colonne 1 du tableau
    End If
   End With
    .Cells(rcell.Row, 2) = Bassins.Value
    .Cells(rcell.Row, 3) = ChoixRLS
    .Cells(rcell.Row, 4) = NUM
    .Cells(rcell.Row, 5) = nomprenom
    .Cells(rcell.Row, 6) = choixlangue
    .Cells(rcell.Row, 7) = TextBox6
    .Cells(rcell.Row, 8) = datenaissance
    .Cells(rcell.Row, 9) = typedemande
    .Cells(rcell.Row, 10) = IntPivot
    .Cells(rcell.Row, 11) = profilintervention
    .Cells(rcell.Row, 12) = profilisosmaf
    .Cells(rcell.Row, 13) = Format(Me.oemcdate.Value, "YYYY/MM/DD")

    MsgBox "Les informations ont été ajoutés à la base de donnée", vbOKOnly + vbInformation, "COMFIRMATION"
  .Protect Password:="CES"
 End With
End Sub

Il y aurait une subtilité dans la ligne de code .cells(rcell.row) = nomprenom. Value (a ajouter ici) afin de pouvoir inscrire le nom et prénom pas plus de deux fois ?

Merci de votre aide !

Bonsoir Anniem,

Pour moi, il n'y a à priori pas de raison pour que le nom s'inscrive 2 fois... surtout que je ne vois pas de boucle For/Next

Est-il possible de déposer le fichier SVP ?

A+

Bonjour BrunoM45,

Le besoin en est. L'usager doit être inscrit deux fois cependant pas plus de deux fois.

J'ajoute le fichier.

Re,

Oups et le mot de passe

oubli de ma part : CES

Re,

Ce que je ne comprends pas quand on, utilise l'USF cela n'inscrit bien qu'une fois la personne

Alors quelle est la problématique exacte SVP ?

A+

Oui vous avez raison. J'aimerais pouvoir y inscrire deux fois la même personne. Novice en VBA je m'exerce avec ce fichier de type "test" avant de pouvoir me lancer en projet.

Pouvez-vous m'indiquer, de part votre expertise, ce que je dois ajouter avant mon Msg box (boucle ) je crois ?

Re,

Je comprends mieux, mais faite attention à vos demandes... ce n'était pas clair du tout

J'ai modifié le titre de votre fil du coup

Voici le code

Private Sub Boutoninscrire_Click()
  Dim rcell As Range
  Dim NbLig As Integer

  With Sheets("Inscriptions")
    .Activate
    If .Range("T_inscription").Rows.Count > 19 Then
      MsgBox "Tableau complet", vbOKOnly + vbInformation, "COMFIRMATION"
      Unload Me
      Exit Sub
    End If

    If Bassins = "" Or ChoixRLS = "" Or NUM = "" Or nomprenom = "" Or choixlangue = "" Or _
      TextBox6 = "" Or datenaissance = "" Or typedemande = "" Or IntPivot = "" Or _
      profilintervention = "" Or profilisosmaf = "" Or oemcdate = "" Then
      MsgBox ("Tous les champs ne sont pas correctement remplis")
      Exit Sub
    End If

    .Unprotect Password:="CES"
    For NbLig = 1 To 2  ' Inscrire 2 fois la ligne
      With .ListObjects("T_inscription")
        If .InsertRowRange Is Nothing Then '...................................si le tableau comporte des données
          Set rcell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1) '....1ère cellule vide (colonne 1 du tableau,nombre de lignes du tableau+1)
        Else
          Set rcell = .InsertRowRange.Cells(1) '................................1ère cellule colonne 1 du tableau
        End If
      End With
      .Cells(rcell.Row, 2) = Bassins.Value
      .Cells(rcell.Row, 3) = ChoixRLS
      .Cells(rcell.Row, 4) = NUM
      .Cells(rcell.Row, 5) = nomprenom
      .Cells(rcell.Row, 6) = choixlangue
      .Cells(rcell.Row, 7) = TextBox6
      .Cells(rcell.Row, 8) = datenaissance
      .Cells(rcell.Row, 9) = typedemande
      .Cells(rcell.Row, 10) = IntPivot
      .Cells(rcell.Row, 11) = profilintervention
      .Cells(rcell.Row, 12) = profilisosmaf
      .Cells(rcell.Row, 13) = Format(Me.oemcdate.Value, "YYYY/MM/DD")
    Next NbLig
    .Protect Password:="CES"
  End With
  MsgBox "Les informations ont été ajoutés à la base de donnée", vbOKOnly + vbInformation, "COMFIRMATION"
End Sub

Sinon, attention, dans votre USF les champs de saisi ne sont pas dans le bon ordre
Il faut modifier l'ordre de tabulation dans

A+

Enfin j'ai compris. Je vais pouvoir corriger avec cette solution.

Merci de tout coeur. Il est possible d'encourager de quelle façon ? Je sais que le tout est bénévole mais je trouve tout ce dont il me faut ici alors j'aimerais pouvoir redonner...

Re,

anniem a écrit :

Enfin j'ai compris. Je vais pouvoir corriger avec cette solution.

Cool

anniem a écrit :

Merci de tout coeur. Il est possible d'encourager de quelle façon ? Je sais que le tout est bénévole mais je trouve tout ce dont il me faut ici alors j'aimerais pouvoir redonner...

Tu peux devenir membre premium et remercier ainsi le forum, en payant un petit quelque chose

https://www.excel-pratique.com/fr/compte/premium-avantages

A+

C'est ce que je ferai