Ajouter tableaux pour insertion de données

Résolu
Nai Messages postés 765 Statut Membre -  
Nai Messages postés 765 Statut Membre -
Bonjour toutes et tous :)
Je ne sais pas si le titre est clair, mais je ne voyais pas comment l'intituler :/

J'ai un fichier de pointage (largement réalisé grâce à la communauté CCM) et souhaite y apporter quelques modifications (l'utilisation sur le terrain rend compte de quelques manques ^^).

Notamment en ce qui concerne le tableau de baignade : 4 tableaux y étaient avant mes modifications et tout fonctionnait à merveille, si ce n'est qu'en pratique il manquait des tableaux.
J'ai donc tenté d'en ajouter 4 autres en prenant exemple sur les 4 précédents. J'ai du rater un truc parce-que ça ne fonctionne pas :(
Si quelqu'un peut me donner une piste de recherche à propos de mon erreur ce serait formidable :)

Les 4 tableaux fonctionnels : 
    Set xl = Application
    If Target.Address = Range("F14").Address Then               'ajouter dans tableau 1
        Unprotect Password:="alsh"
        Call ListBox1_LostFocus
        If Not nageur_ok Then Exit Sub
        With Range("tableau1")
            Set cellule_première_ligne = .Columns(1).Offset(-1).Resize(.Rows.Count + 1).Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)
            If cellule_première_ligne Is Nothing Then MsgBox "Le nombre d'enfant maximum est atteint pour ce tableau": Exit Sub
            Set ligne = cellule_première_ligne.Resize(, .Columns.Count)
        End With
        Tinfos = Split(ListBox1.Value, " - ")
        'Control doublons
        If Not ctrl_doublon(Tinfos) Then
                GoTo Traite_Erreur
        End If
        ligne.Resize(, UBound(Tinfos) + 1).Value = xl.Transpose(xl.Transpose(Tinfos))
        ligne.Columns(4).FormulaR1C1 = "=IF(RC[-1]<>"""",DATEDIF(RC[-1],R7C4,""y""),"""")"
    End If
    
    If Target.Address = Range("G14").Address Then               'enlever dans tableau 1
        Unprotect Password:="alsh"
         Application.EnableEvents = False
      Range("A25") = "Sélectionnez le NOM de l'enfant pour le supprimer"
       While Selection.Address = Target.Address
            DoEvents
       Wend
       Range("A25") = Empty
       If xl.Intersect(Selection.Rows, Range("tableau1")) Is Nothing Then MsgBox "Vous n'avez pas sélectionné le nom d'un enfant à supprimer": Exit Sub
       With Range("tableau1")
            i1 = Selection.Row - .Row + 1       '1ère ligne du tableau à enlever
            i2 = i1 + Selection.Rows.Count - 1  'dernière ligne du tableau à enlever
            i3 = .Rows.Count                    'n°dernière ligne du tableau
            If Not i2 + 1 > i3 Then copie = Range(.Rows(i2 + 1), .Rows(i3)).Value
            Range(.Rows(i1), .Rows(i3)).ClearContents
            If Not i2 + 1 > i3 Then .Rows(i1).Resize(UBound(copie, 1)).Value = copie
       End With
    End If
    
    If Target.Address = Range("N14").Address Then               'ajouter dans tableau 2
        Unprotect Password:="alsh"
        Call ListBox1_LostFocus
        If Not nageur_ok Then Exit Sub
        With Range("tableau2")
            Set cellule_première_ligne = .Columns(1).Offset(-1).Resize(.Rows.Count + 1).Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)
            If cellule_première_ligne Is Nothing Then MsgBox "Le nombre d'enfant maximum est atteint pour ce tableau": Exit Sub
            Set ligne = cellule_première_ligne.Resize(, .Columns.Count)
        End With
        Tinfos = Split(ListBox1.Value, " - ")
        'Control doublons
        If Not ctrl_doublon(Tinfos) Then
                GoTo Traite_Erreur
        End If
        ligne.Resize(, UBound(Tinfos) + 1).Value = xl.Transpose(xl.Transpose(Tinfos))
        ligne.Columns(4).FormulaR1C1 = "=IF(RC[-1]<>"""",DATEDIF(RC[-1],R7C4,""y""),"""")"
    End If
    
    If Target.Address = Range("O14").Address Then               'enlever dans tableau 2
         Unprotect Password:="alsh"
        Application.EnableEvents = False
      Range("I25") = "Sélectionnez le NOM de l'enfant pour le supprimer"
       While Selection.Address = Target.Address
            DoEvents
       Wend
       Range("I25") = Empty
       If xl.Intersect(Rows(Selection.Row), Range("tableau2")) Is Nothing Then MsgBox "Vous n'avez pas sélectionné le nom d'un enfant à supprimer": Exit Sub
       With Range("tableau2")
            i1 = Selection.Row - .Row + 1       '1ère ligne du tableau à enlever
            i2 = i1 + Selection.Rows.Count - 1  'dernière ligne du tableau à enlever
            i3 = .Rows.Count                    'n°dernière ligne du tableau
            If Not i2 + 1 > i3 Then copie = Range(.Rows(i2 + 1), .Rows(i3)).Value
            Range(.Rows(i1), .Rows(i3)).ClearContents
            If Not i2 + 1 > i3 Then .Rows(i1).Resize(UBound(copie, 1)).Value = copie
       End With
    End If
    If Target.Address = Range("F26").Address Then               'ajouter dans tableau 3
         Unprotect Password:="alsh"
       Call ListBox1_LostFocus
        If Not nageur_ok Then Exit Sub
        With Range("tableau3")
            Set cellule_première_ligne = .Columns(1).Offset(-1).Resize(.Rows.Count + 1).Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)
            If cellule_première_ligne Is Nothing Then MsgBox "Le nombre d'enfant maximum est atteint pour ce tableau": Exit Sub
            Set ligne = cellule_première_ligne.Resize(, .Columns.Count)
        End With
        Tinfos = Split(ListBox1.Value, " - ")
        'Control doublons
        If Not ctrl_doublon(Tinfos) Then
                GoTo Traite_Erreur
        End If
        ligne.Resize(, UBound(Tinfos) + 1).Value = xl.Transpose(xl.Transpose(Tinfos))
        ligne.Columns(4).FormulaR1C1 = "=IF(RC[-1]<>"""",DATEDIF(RC[-1],R7C4,""y""),"""")"
    End If
    
    If Target.Address = Range("G26").Address Then               'enlever dans tableau 3
        Unprotect Password:="alsh"
        Application.EnableEvents = False
       Range("A25") = "Sélectionnez le NOM de l'enfant pour le supprimer"
       While Selection.Address = Target.Address
            DoEvents
       Wend
       Range("A25") = Empty
       If xl.Intersect(Rows(Selection.Row), Range("tableau3")) Is Nothing Then MsgBox "Vous n'avez pas sélectionné le nom d'un enfant à supprimer": Exit Sub
       With Range("tableau3")
            i1 = Selection.Row - .Row + 1       '1ère ligne du tableau à enlever
            i2 = i1 + Selection.Rows.Count - 1  'dernière ligne du tableau à enlever
            i3 = .Rows.Count                    'n°dernière ligne du tableau
            If Not i2 + 1 > i3 Then copie = Range(.Rows(i2 + 1), .Rows(i3)).Value
            Range(.Rows(i1), .Rows(i3)).ClearContents
            If Not i2 + 1 > i3 Then .Rows(i1).Resize(UBound(copie, 1)).Value = copie
       End With
    End If
    
    If Target.Address = Range("N26").Address Then               'ajouter dans tableau 4
        Unprotect Password:="alsh"
        Call ListBox1_LostFocus
        If Not nageur_ok Then Exit Sub
        With Range("tableau4")
            Set cellule_première_ligne = .Columns(1).Offset(-1).Resize(.Rows.Count + 1).Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)
            If cellule_première_ligne Is Nothing Then MsgBox "Le nombre d'enfant maximum est atteint pour ce tableau": Exit Sub
            Set ligne = cellule_première_ligne.Resize(, .Columns.Count)
        End With
        Tinfos = Split(ListBox1.Value, " - ")
        'Control doublons
        If Not ctrl_doublon(Tinfos) Then
                GoTo Traite_Erreur
        End If
        ligne.Resize(, UBound(Tinfos) + 1).Value = xl.Transpose(xl.Transpose(Tinfos))
        ligne.Columns(4).FormulaR1C1 = "=IF(RC[-1]<>"""",DATEDIF(RC[-1],R7C4,""y""),"""")"
    End If
    
    If Target.Address = Range("O26").Address Then               'enlever dans tableau 4
        Unprotect Password:="alsh"
        Application.EnableEvents = False
       Range("I25") = "Sélectionnez le NOM de l'enfant pour le supprimer"
       While Selection.Address = Target.Address
            DoEvents
       Wend
       Range("I25") = Empty
       If xl.Intersect(Rows(Selection.Row), Range("tableau4")) Is Nothing Then MsgBox "Vous n'avez pas sélectionné le nom d'un enfant à supprimer": Exit Sub
       With Range("tableau4")
            i1 = Selection.Row - .Row + 1       '1ère ligne du tableau à enlever
            i2 = i1 + Selection.Rows.Count - 1  'dernière ligne du tableau à enlever
            i3 = .Rows.Count                    'n°dernière ligne du tableau
            If Not i2 + 1 > i3 Then copie = Range(.Rows(i2 + 1), .Rows(i3)).Value
            Range(.Rows(i1), .Rows(i3)).ClearContents
            If Not i2 + 1 > i3 Then .Rows(i1).Resize(UBound(copie, 1)).Value = copie
       End With
    End If


J'ai juste repris ces 4 tableaux que j'ai réadapté aux tableaux 5, 6, 7 et 8 : 
   If Target.Address = Range("F38").Address Then               'ajouter dans tableau 5
        Unprotect Password:="alsh"
        Call ListBox1_LostFocus
        If Not nageur_ok Then Exit Sub
        With Range("tableau5")
            Set cellule_première_ligne = .Columns(1).Offset(-1).Resize(.Rows.Count + 1).Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)
            If cellule_première_ligne Is Nothing Then MsgBox "Le nombre d'enfant maximum est atteint pour ce tableau": Exit Sub
            Set ligne = cellule_première_ligne.Resize(, .Columns.Count)
        End With
        Tinfos = Split(ListBox1.Value, " - ")
        'Control doublons
        If Not ctrl_doublon(Tinfos) Then
                GoTo Traite_Erreur
        End If
        ligne.Resize(, UBound(Tinfos) + 1).Value = xl.Transpose(xl.Transpose(Tinfos))
        ligne.Columns(4).FormulaR1C1 = "=IF(RC[-1]<>"""",DATEDIF(RC[-1],R7C4,""y""),"""")"
    End If
    
    If Target.Address = Range("G38").Address Then               'enlever dans tableau 5
        Unprotect Password:="alsh"
         Application.EnableEvents = False
      Range("A49") = "Sélectionnez le NOM de l'enfant pour le supprimer"
       While Selection.Address = Target.Address
            DoEvents
       Wend
       Range("A49") = Empty
       If xl.Intersect(Selection.Rows, Range("tableau5")) Is Nothing Then MsgBox "Vous n'avez pas sélectionné le nom d'un enfant à supprimer": Exit Sub
       With Range("tableau5")
            i1 = Selection.Row - .Row + 1       '1ère ligne du tableau à enlever
            i2 = i1 + Selection.Rows.Count - 1  'dernière ligne du tableau à enlever
            i3 = .Rows.Count                    'n°dernière ligne du tableau
            If Not i2 + 1 > i3 Then copie = Range(.Rows(i2 + 1), .Rows(i3)).Value
            Range(.Rows(i1), .Rows(i3)).ClearContents
            If Not i2 + 1 > i3 Then .Rows(i1).Resize(UBound(copie, 1)).Value = copie
       End With
    End If
    
    If Target.Address = Range("N38").Address Then               'ajouter dans tableau 6
        Unprotect Password:="alsh"
        Call ListBox1_LostFocus
        If Not nageur_ok Then Exit Sub
        With Range("tableau6")
            Set cellule_première_ligne = .Columns(1).Offset(-1).Resize(.Rows.Count + 1).Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)
            If cellule_première_ligne Is Nothing Then MsgBox "Le nombre d'enfant maximum est atteint pour ce tableau": Exit Sub
            Set ligne = cellule_première_ligne.Resize(, .Columns.Count)
        End With
        Tinfos = Split(ListBox1.Value, " - ")
        'Control doublons
        If Not ctrl_doublon(Tinfos) Then
                GoTo Traite_Erreur
        End If
        ligne.Resize(, UBound(Tinfos) + 1).Value = xl.Transpose(xl.Transpose(Tinfos))
        ligne.Columns(4).FormulaR1C1 = "=IF(RC[-1]<>"""",DATEDIF(RC[-1],R7C4,""y""),"""")"
    End If
    
    If Target.Address = Range("O38").Address Then               'enlever dans tableau 6
         Unprotect Password:="alsh"
        Application.EnableEvents = False
      Range("I49") = "Sélectionnez le NOM de l'enfant pour le supprimer"
       While Selection.Address = Target.Address
            DoEvents
       Wend
       Range("I49") = Empty
       If xl.Intersect(Rows(Selection.Row), Range("tableau6")) Is Nothing Then MsgBox "Vous n'avez pas sélectionné le nom d'un enfant à supprimer": Exit Sub
       With Range("tableau6")
            i1 = Selection.Row - .Row + 1       '1ère ligne du tableau à enlever
            i2 = i1 + Selection.Rows.Count - 1  'dernière ligne du tableau à enlever
            i3 = .Rows.Count                    'n°dernière ligne du tableau
            If Not i2 + 1 > i3 Then copie = Range(.Rows(i2 + 1), .Rows(i3)).Value
            Range(.Rows(i1), .Rows(i3)).ClearContents
            If Not i2 + 1 > i3 Then .Rows(i1).Resize(UBound(copie, 1)).Value = copie
       End With
    End If
    
    If Target.Address = Range("F50").Address Then               'ajouter dans tableau 7
         Unprotect Password:="alsh"
       Call ListBox1_LostFocus
        If Not nageur_ok Then Exit Sub
        With Range("tableau7")
            Set cellule_première_ligne = .Columns(1).Offset(-1).Resize(.Rows.Count + 1).Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)
            If cellule_première_ligne Is Nothing Then MsgBox "Le nombre d'enfant maximum est atteint pour ce tableau": Exit Sub
            Set ligne = cellule_première_ligne.Resize(, .Columns.Count)
        End With
        Tinfos = Split(ListBox1.Value, " - ")
        'Control doublons
        If Not ctrl_doublon(Tinfos) Then
                GoTo Traite_Erreur
        End If
        ligne.Resize(, UBound(Tinfos) + 1).Value = xl.Transpose(xl.Transpose(Tinfos))
        ligne.Columns(4).FormulaR1C1 = "=IF(RC[-1]<>"""",DATEDIF(RC[-1],R7C4,""y""),"""")"
    End If
    
    If Target.Address = Range("G50").Address Then               'enlever dans tableau 7
        Unprotect Password:="alsh"
        Application.EnableEvents = False
       Range("A49") = "Sélectionnez le NOM de l'enfant pour le supprimer"
       While Selection.Address = Target.Address
            DoEvents
       Wend
       Range("A49") = Empty
       If xl.Intersect(Rows(Selection.Row), Range("tableau7")) Is Nothing Then MsgBox "Vous n'avez pas sélectionné le nom d'un enfant à supprimer": Exit Sub
       With Range("tableau7")
            i1 = Selection.Row - .Row + 1       '1ère ligne du tableau à enlever
            i2 = i1 + Selection.Rows.Count - 1  'dernière ligne du tableau à enlever
            i3 = .Rows.Count                    'n°dernière ligne du tableau
            If Not i2 + 1 > i3 Then copie = Range(.Rows(i2 + 1), .Rows(i3)).Value
            Range(.Rows(i1), .Rows(i3)).ClearContents
            If Not i2 + 1 > i3 Then .Rows(i1).Resize(UBound(copie, 1)).Value = copie
       End With
    End If
    
    If Target.Address = Range("N50").Address Then               'ajouter dans tableau 8
        Unprotect Password:="alsh"
        Call ListBox1_LostFocus
        If Not nageur_ok Then Exit Sub
        With Range("tableau8")
            Set cellule_première_ligne = .Columns(1).Offset(-1).Resize(.Rows.Count + 1).Find("", SearchOrder:=xlRows, SearchDirection:=xlNext)
            If cellule_première_ligne Is Nothing Then MsgBox "Le nombre d'enfant maximum est atteint pour ce tableau": Exit Sub
            Set ligne = cellule_première_ligne.Resize(, .Columns.Count)
        End With
        Tinfos = Split(ListBox1.Value, " - ")
        'Control doublons
        If Not ctrl_doublon(Tinfos) Then
                GoTo Traite_Erreur
        End If
        ligne.Resize(, UBound(Tinfos) + 1).Value = xl.Transpose(xl.Transpose(Tinfos))
        ligne.Columns(4).FormulaR1C1 = "=IF(RC[-1]<>"""",DATEDIF(RC[-1],R7C4,""y""),"""")"
    End If
    
    If Target.Address = Range("O50").Address Then               'enlever dans tableau 8
        Unprotect Password:="alsh"
        Application.EnableEvents = False
       Range("I49") = "Sélectionnez le NOM de l'enfant pour le supprimer"
       While Selection.Address = Target.Address
            DoEvents
       Wend
       Range("I49") = Empty
       If xl.Intersect(Rows(Selection.Row), Range("tableau8")) Is Nothing Then MsgBox "Vous n'avez pas sélectionné le nom d'un enfant à supprimer": Exit Sub
       With Range("tableau8")
            i1 = Selection.Row - .Row + 1       '1ère ligne du tableau à enlever
            i2 = i1 + Selection.Rows.Count - 1  'dernière ligne du tableau à enlever
            i3 = .Rows.Count                    'n°dernière ligne du tableau
            If Not i2 + 1 > i3 Then copie = Range(.Rows(i2 + 1), .Rows(i3)).Value
            Range(.Rows(i1), .Rows(i3)).ClearContents
            If Not i2 + 1 > i3 Then .Rows(i1).Resize(UBound(copie, 1)).Value = copie
       End With
    End If

Le problème vient peut-être d'ailleurs, mais je ne vois pas :(
Dans le doute, voici le fichier : https://www.cjoint.com/c/HIelIPogYqe et sa bdd (nécessaire pour ajouter les enfants aux tableaux) : https://www.cjoint.com/c/HIelJLrTsIe

Je vous remercie infiniment de votre aide (passée, présente, et évidemment future) :)


A voir également:

1 réponse

Réponse 1 / 1
yg_be Messages postés 24281 Statut Contributeur Ambassadeur 1 584
 
bonjour, "ça ne fonctionne pas": message d'erreur, résultat inattendu, ?
1
Nai Messages postés 765 Statut Membre 55
 
Dès l'ouverture du fichier ? :O
Fichier corrompu ? :/
Je retente : https://www.cjoint.com/c/HIemN22sPWe
0
yg_be Messages postés 24281 Statut Contributeur 1 584 > Nai Messages postés 765 Statut Membre
 
tu n'as pas décrit ton soucis: tu as simplement écrit "ça ne fonctionne pas", mais tu n'as pas précisé si tu avais un message d'erreur, un résultat inattendu, ou encore autre chose.
donc je te demande d'être plus précise.
0
Nai Messages postés 765 Statut Membre 55
 
Ah ! Je suis nouille ! :$
Pas de message d'erreur. Tout semble fonctionner (sans fonctionner) ^^
L'enfant n'est ni ajouté ni supprimé :/
0
yg_be Messages postés 24281 Statut Contributeur 1 584 > Nai Messages postés 765 Statut Membre
 
si j'ouvre ton fichier, comment puis-je observer ou provoquer le problème?
0
Nai Messages postés 765 Statut Membre 55
 
Ah pardon ! :s
Dans l'onget Tableau baignade. Dans la zone "Sélection des nageurs" -> Taper une lettre. Sélectionner un enfant (mettre en surbrillance) et cliquer sur un + vert. Les quatre premiers tableaux fonctionnent. Pas les quatre suivants.
Pour supprimer un enfant : Cliquer sur le - rouge puis sur le nom de l'enfant.
Pour en supprimer plusieurs : Clic - rouge puis sélectionner les noms à supprimer.
Idem, les quatre premier fonctionnent, mais pas les autres :(

Merci de ta patience :$
0

Discussions similaires

Comment savoir comment on nous a ajouté sur Snap
Laura -
Lob6 -

15 réponses