XL 2021 Case à cocher afin d'insérer des lignes dans une autre feuille

[Icefedor]

Bonjour à tous ,

Après plusieurs jours d'essais et de test, je me resigne à vous demander de l'aide!

Je cherche à insérer des lignes (Depuis la feuille "Option") dans une feuille qui sera un devis final ( Feuille "Trame")

L'idée est de cocher des cases pour que cela copie la ligne jointe et l'insère dans le tableau sur une autre feuille.

J'arrive à créer la macro et la lier à la case à cocher mais:

- Est-il possible que si cette case à cocher est décochée, cela supprime les lignes qui avaient été insérées?
- si je coche plusieurs case à la suite, que les textes soient insérer à la suite aussi?

Merci beaucoup pour votre aide !

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @Icefedor

Une solution sans case à cocher, (fonctionnalité remplacée par un clic droit dans la colonne Qté) qui a l'avantage de ne pas nécessité d'ajouter ou de supprimer des objets lorsque le nombre de lignes évolue.

J'ai créé 4 tableaux structurés dans la feuille Options, ils s'étendent automatiquement en tapant la touche Tab dans leur dernière cellule (en bas à droite), se réduisent en utilisant Supprimer, ligne du tableau après un clic droit sur la ligne à supprimer (sauf cellule Qté utilisée pour ajouter / supprimer les lignes dans l'onglet Trame).

De même j'ai créé 4 tableaux structuré dans l'onglet trame, avec les mêmes noms de colonnes sauf que la ligne d'entête n'est pas affichée. Le clic droit dans les colonnes Qté de l'onglet Options gère l'extention, réduction de ces 4 tableaux.

La recherche se fait sur la valeur de la colonne "Exécution", qui ne doit pas se répéter dans un même tableau (possible dans 2 tableaux différents).

Le code se trouve dans la feuille "Options" (nom de code "Sh_Options")

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   
     Dim Nom_Tableau$, Ligne As Range, Exécution$, Cible As Range, NbLgn As Long, Idx As Long
   
     'Vérifier que Target est une seule cellule et qu'elle appartient à une des colonne Qté
     If Target.Count = 1 And Not Intersect(Target, Union([Tb_Machine[Qté]], [Tb_Commande[Qté]], [Tb_Systèmes_de_Butée[Qté]], [Tb_Outils[Qté]])) Is Nothing Then
         
          'Nom du tableau source
          Nom_Tableau = Target.ListObject.Name
          'Ligne concernée du tableau
          Set Ligne = Intersect(Evaluate(Nom_Tableau), Target.EntireRow)
          'Texte de la colonne "Exécution"
          Exécution = Ligne.Cells(2).Value
          'Plage du tableau cible (dans l'onglet Trame)
          Set Cible = Evaluate(Replace(Nom_Tableau, "Tb", "Trm"))
          'Nombre de lignes du tableau cible
          NbLgn = Cible.Rows.Count
         
          'Recherche de la valeur "Exécution" dans le tableau cible, 0 si échec
          Idx = 0: On Error Resume Next: Idx = WorksheetFunction.Match(Exécution, Cible.Columns(2), 0): On Error GoTo 0
         
          Select Case Target.Value
               Case 0
                    Target = 1     'basculer de 0 à 1
                    If Idx = 0 Then
                         'La ligne n'existe pas dans Trame
                         If NbLgn > 1 Or Cible.Cells(1, 2) <> "" Then
                              'Le tableau n'est pas vide : on ajoute une ligne
                              Cible.ListObject.ListRows.Add AlwaysInsert:=False
                              Set Cible = Evaluate(Cible.ListObject.Name)
                         End If
                         'On complète la nouvelle ligne
                         With Cible.Rows(Cible.Rows.Count)
                              .Cells(1) = Ligne.Cells(1)
                              .Cells(2) = Exécution
                              .Cells(3) = Ligne.Cells(3)
                              .Cells(4) = Ligne.Cells(4)
                         End With
                    Else
                         'La ligne existe déjà dans le tableau cible : on ne fait rien
                         MsgBox "La ligne existe déjà dans la trame !"
                    End If
                   
               Case 1
                    Target = 0     'basculer de 1 à 0
                    If Idx = 0 Then
                         'La ligne n'apparaît pas dans le tableau cible
                         MsgBox "La ligne n'apparaît pas dans la trame !"
                    Else
                         If NbLgn = 1 Then
                              'si le tableau cible ne comporte qu'une ligne on vide cette ligne (sauf la formule Prix Total)
                              Cible.Cells(1).Resize(1, 4).ClearContents
                         Else
                              'Si le tableau cible comporte plus d'une ligne on supprime la ligne concernée
                              Cible.ListObject.ListRows(Idx).Delete
                         End If
                    End If
          End Select
         
          'On désactive le clic droit
          Cancel = True
     End If
End Sub

Voilà, voir la pièce jointe
à bientôt

 

[Icefedor]

Bonsoir Alain !

Un grand Merci ! C'est Parfait! c'est top !

Merci , mille merci !