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