Microsoft 365 VBA Supprimer des lignes de tableau avec une sélection manuelle

[Benoit84]

Bonjour
Dans un tableau excel pour supprimer des lignes on sélectionne les cellules dans le tableau puis on fait bouton droit, supprimer puis supprimer ligne de tableau.
Pour des utilisateurs peu expériomenter d'excel, je voudrais créer une macro à lancer (en appuyant sur un bouton) après avoir fait la sélection des lignes.

J'ai essayé sans succès,

exemple

Dim MaPlage As Range

MaPlage = Range(ma selection manuelle en cours)
Selection.ListObject.ListRows(?).Delete

Pouvez vous m'aider ?
merci d'avance

 

[vgendron]

bonjour

Pas sur d'avoir compris..
mais pour supprimer les lignes sélectionnées

selection.entirerow.delete

 

[Dranreb]

Bonjour.
J'utilise dans quelques classeurs des Shape "GrpInsérer" et "GrpSuppr" gérés par ce code :

Option Explicit
Private TCoupé(), Coupé As Boolean
Sub PositImages(ByVal LaFeuille As Worksheet, ByVal RngLig As Range, ByVal InsérerAprès As Boolean)
   Dim LO As ListObject, L As Long, Cas As Long, X As Double
   Set LO = LaFeuille.ListObjects(1)
   L = RngLig.Row - LO.HeaderRowRange.Row
   With LaFeuille.Shapes("GrpSuppr")
      .Visible = L > 0 And L <= LO.ListRows.Count
      If .Visible Then
         .Left = LO.ListColumns("B").Range.Offset(, 1).Left - 18: .Top = RngLig.Top
         While .TopLeftCell.Offset(, 1) <> "": .Left = .TopLeftCell.Offset(, 2).Left - 18: Wend
         End If: End With
   With LaFeuille.Shapes("GrpInsérer")
      If InsérerAprès Then L = L + 1: Set RngLig = RngLig.Offset(1)
      .Visible = L > 0 And L <= LO.ListRows.Count + 1
      If .Visible Then
         .Top = RngLig.Top - .Height / 2: .Left = 0
         .Left = .TopLeftCell.Left + .TopLeftCell.Width - .Width + 3
         Cas = 2 - (L <= LO.ListRows.Count)
      Else: Cas = 1: End If
      End With
   Application.EnableEvents = False
   LaFeuille.[Insertion].Value = "  " & Choose(Cas, "(sans modifier la liste)", _
      "… et ajouter sa couleur à la liste.", "… et insérer sa couleur dans la liste.")
   Application.EnableEvents = True
   End Sub
Sub ImageInsérer()
   Dim Cel As Range
   If Coupé Then
      Set Cel = LigneInsérée(ActiveSheet).Columns(2)
      Cel.Resize(, 12).Value = TCoupé: Coupé = False
      ÉtudeChange ActiveSheet, Cel
   Else: LigneInsérée ActiveSheet: End If
   End Sub
Function LigneInsérée(ByVal LaFeuille As Worksheet) As Range
   Dim Img As Shape, LO As ListObject, L As Long
   Set Img = LaFeuille.Shapes("GrpInsérer")
   Set LO = LaFeuille.ListObjects(1)
   If Img.Visible Then L = Img.BottomRightCell.Row - LO.HeaderRowRange.Row
   If L < 1 Or L > LO.ListRows.Count Then L = LO.ListRows.Count + 1
   Set LigneInsérée = LO.ListRows.Add(L).Range
   PositImages LaFeuille, LigneInsérée, InsérerAprès:=True
   End Function
Sub ImageSupprimer()
   Dim Img As Shape, LO As ListObject, L As Long
   Set Img = ActiveSheet.Shapes("GrpSuppr")
   Set LO = ActiveSheet.ListObjects(1)
   L = Img.TopLeftCell.Row - LO.HeaderRowRange.Row
   With LO.ListRows(L): Coupé = True: TCoupé = .Range.Columns(2).Resize(, 12).Value: .Delete: End With
   If LO.ListRows.Count = 0 Then [G4].Interior.Color = &HCACACA: Exit Sub
   Img.Visible = False
   ActiveSheet.Shapes("GrpInsérer").Visible = False
   PositImages ActiveSheet, LO.HeaderRowRange.Offset(L), InsérerAprès:=False
   End Sub

En résumé si vous avez pris soin de positionner convenablement votre petit bouton Img de suppression sur la ligne à supprimer possiblement, le numéro du ListRow à supprimer du ListObject LO est donné par Img.TopLeftCell.Row - LO.HeaderRowRange.Row
Sinon, si c'est moins sophistiqué, Selection.Row - LO.HeaderRowRange.Row devrait marcher aussi.
Remarque: les ListObject n'ont aparremment pas de méthode permettant de supprimer ni insérer plusieurs ListRow contigus. Mais je pense que dans ce cas on peut utiliser :
LO.ListRows(L).Range.Resize(n).Delete xlShiftUp
Suite à un essai je viens d'avoir la surprise de voir l'enregistreur de macro avoir engendré n fois ListRows(L).Delete ! Ce qu'on peut imiter plutôt avec une boucle bien sûr.

 

[Hasco]

Bonjour,

Avec ce que je comprends de votre question :

Sub RemoveListRows()
    Dim sel As Range, lo As ListObject
    Set lo = ThisWorkbook.Sheets("Feuil1").ListObjects(1)
    Set sel = Intersect(lo.DataBodyRange, Selection.EntireRow)
    If Not sel Is Nothing Then sel.Delete xlShiftUp
End Sub

 

[mapomme]

Bonjour @Benoit84 et aux autres 🙂,

Un autre essai qui gère aussi les sélections multiples (plusieurs cellules sélectionnées non contigües au sein de la même ligne)

• Sélectionner des cellules dans et/ou en dehors du tableau structuré
• inutile de sélectionner une ligne entière du tableau (au moins une cellule de la ligne suffit)
• cliquer sur le bouton hop!

Le code est dans le module de la feuille "Feuil1"

Sub SupprLigne()
Dim x As Range, y As Range, z As Range

Set x = Intersect(Me.ListObjects(1).DataBodyRange, Selection)
If x Is Nothing Then Exit Sub
For Each y In x
   If z Is Nothing Then
      Set z = Intersect(Rows(y.Row), Me.ListObjects(1).DataBodyRange)
   Else
      Set z = Union(z, Intersect(Rows(y.Row), Me.ListObjects(1).DataBodyRange))
   End If
Next y
If Not z Is Nothing Then z.Delete shift:=xlShiftUp: Me.Shapes(Application.Caller).TopLeftCell.Select
End Sub

 

[Hasco]

Bonjour @mapomme 🙂

Ou me trompe-je ou il me semble que

Intersect(lo.DataBodyRange, Selection)
sel.Delete xlShiftUp

Gère les multiselections

Peut-être à rajouté : EntireRow à Selection dans Intersect(lo.DataBodyRange, Selection)

Cordialement

[Edit] je viens de corriger dans le fichier du post #4

 

[mapomme]

Ou me trompe-je ou il me semble que

Bonjour @Roblochon 🙂 ,

Si dans ton fichier, je sélectionne B5 et E5 (avec office 365), j’aboutis à une erreur 1004 sur l'instruction Delete: "Impossible d'utiliser cette commande sur des sélections qui se superposent."

 

[Hasco]

Re @mapomme

Je viens de tester avec la correction apportée (Set sel = Intersect(lo.DataBodyRange, Selection.EntireRow))

Sans EntireRow ça plante, avec ça ne plante plus. Logique.

Cordialement

 

[Benoit84]

Bonjour à vous,
Merci de vos différentes solutions, c'est exactement ce qu'il fallait.
J'ai eu un peu de mal à l'adapter dans mon tableau, il ne marchait pas car je n'avais pas mit le code dans la feuille du tableau mais dans un module.
Tout fonctionne, je vous remercie pour votre aide 😉

bonne journée
Cordialement