XL 2016 Créer un macro pour supprimer une ligne de tableau

Ayem

XLDnaute Nouveau
Bonjour à tous
J'aimerais savoir si possible comment créer un macro qui supprimerait automatiquement une ligne de tableau que j'aurais pointer grâce à mon curseur ?
Merci
 

Dranreb

XLDnaute Barbatruc
Bonjour
J'utilise assez volontiers des groupes d'images.
1604933341440.png
1604933371549.png

Ils sont gérés par un module MInsSuppr dont voici le code :
VB:
Option Explicit
Private TCoupé(), Coupé As Boolean
Sub PositImages(ByVal LaFeuille As Worksheet, ByVal Cel As Range, ByVal InsérerAprès As Boolean)
   Dim LO As ListObject, L As Long
   Set LO = LaFeuille.ListObjects(1)
   L = Cel.Row - LO.HeaderRowRange.Row
   With LaFeuille.Shapes("GrpSuppr")
      .Visible = L > 0 And L <= LO.ListRows.Count And Cel.Rows.Count = 1
      If .Visible Then .Top = Cel.Top + (Cel.Height - .Height) / 2: .Left = LO.Range.Left + LO.Range.Width
      End With
   With LaFeuille.Shapes("GrpInsérer")
      If InsérerAprès Then L = L + 1: Set Cel = Cel.Offset(1)
      .Visible = L > 0 And L <= LO.ListRows.Count + 1 And Cel.Rows.Count = 1
      If .Visible Then .Top = Cel.Top - .Height / 2 + 0.75: .Left = LO.Range.Left - .Width + 6
      End With
   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
   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 + Img.BottomRightCell.Row) \ 2 - 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 Exit Sub
   Img.Visible = False
   ActiveSheet.Shapes("GrpInsérer").Visible = False
   PositImages ActiveSheet, LO.HeaderRowRange.Offset(L), InsérerAprès:=False
   End Sub
 

Discussions similaires

Réponses
15
Affichages
527
Réponses
2
Affichages
366

Statistiques des forums

Discussions
311 735
Messages
2 082 023
Membres
101 873
dernier inscrit
excellllll