Ajouter tableaux pour insertion de données

Résolu/Fermé

Nai Messages postés 711 Date d'inscription vendredi 29 avril 2005 Statut Membre Dernière intervention 25 août 2023 - 4 sept. 2018 à 13:37
Nai Messages postés 711 Date d'inscription vendredi 29 avril 2005 Statut Membre Dernière intervention 25 août 2023 - 4 sept. 2018 à 19:35

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:

Ajouter tableaux pour insertion de données
Insertion signature word - Guide
Insertion liste déroulante excel - Guide
Ajouter un compte gmail - Guide
Tableaux croisés dynamiques - Guide
Ajouter un profil netflix payant - Guide

1 réponse

Réponse 1 / 1

yg_be Messages postés 22708 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 20 avril 2024 1 474
4 sept. 2018 à 13:45

bonjour, "ça ne fonctionne pas": message d'erreur, résultat inattendu, ?

Nai Messages postés 711 Date d'inscription vendredi 29 avril 2005 Statut Membre Dernière intervention 25 août 2023 54
4 sept. 2018 à 14:40

Dès l'ouverture du fichier ? :O
Fichier corrompu ? :/
Je retente : https://www.cjoint.com/c/HIemN22sPWe

yg_be Messages postés 22708 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 20 avril 2024 1 474 > Nai Messages postés 711 Date d'inscription vendredi 29 avril 2005 Statut Membre Dernière intervention 25 août 2023
4 sept. 2018 à 17:23

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.

Nai Messages postés 711 Date d'inscription vendredi 29 avril 2005 Statut Membre Dernière intervention 25 août 2023 54
4 sept. 2018 à 17:55

Ah ! Je suis nouille ! :$
Pas de message d'erreur. Tout semble fonctionner (sans fonctionner) ^^
L'enfant n'est ni ajouté ni supprimé :/

si j'ouvre ton fichier, comment puis-je observer ou provoquer le problème?

Nai Messages postés 711 Date d'inscription vendredi 29 avril 2005 Statut Membre Dernière intervention 25 août 2023 54
4 sept. 2018 à 18:02

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 :$

Discussions similaires

Retrouver l'image originale après avoir fait des modifications ?

Nettoyer une base de données avec une liste

ou sont les bananes ?

Discussions similaires

Newsletters