Dim s As Shape, x As String
' from MTH and JBoisgontier
Sub img()
For Each s In ActiveSheet.Shapes
x = s.TopLeftCell.Address
Range(x).Offset(0, 1) = s.Name
Next s
End Sub
Sub CollerImage()
Dim F As Worksheet, Nom As String
SuppressionIm
NomImage = [ImageName].Value
Sheets("Liste").Shapes(NomImage).Copy
Sheets("Header").Select [COLOR=rgb(226, 80, 65)]'Faire également pour les onglets només de 1 à 25 ?[/COLOR]
[ImageName].Select
ActiveSheet.Paste
CentrerImg
[A1].Select
End Sub
Sub SuppressionIm()
On Error GoTo EndSuppressionIm
For Each sh In Sheets("Header").Shapes [COLOR=rgb(184, 49, 47)]'Faire également pour les onglets només de 1 à 25 ?[/COLOR]
If Not Application.Intersect(sh.TopLeftCell, [ImageName]) Is Nothing Then
sh.Delete
End If
Next sh
EndSuppressionIm:
End Sub
Sub CentrerImg()
Dim obj As Shape, c As Range, p As Long
For Each obj In ActiveSheet.Shapes
If obj.Type = msoPicture Then
Set c = obj.TopLeftCell
' ajuster hauteur
obj.Top = c.Top + (c.Top + obj.Top) / 4
' centrer
obj.Left = c.Left + (c.Width - obj.Width) / 2
End If
Next obj
End Sub