Sub Tests_B()
Application.ScreenUpdating = False
Supprimer_Images Sheets("Feuil1"), msoPicture
End Sub
Private Sub Supprimer_Images(Feuille As Worksheet, TypeShp As MsoShapeType)
Dim shp As shape
On Error Resume Next
For Each shp In Feuille.Shapes
If shp.Type = TypeShp Then
shp.Delete
End If
Next
End Sub
Re
En cherchant bien, on pouvait par un heureux hasard tomber sur cette discussion
S'en inspirer (en inversant la logique)
Tu vois comment faire?
Sub tests()
Application.ScreenUpdating = False
Supprimer_Shapes_et_Images Sheets("Feuil1")
End Sub
Private Sub Supprimer_Shapes_et_Images(Feuille As Worksheet)
Dim shp As Shape
On Error Resume Next
For Each shp In Feuille.Shapes
'supprime les shapes et les images
If Len(shp.OLEFormat.Object.Name) Or shp.Type = 13 Then
shp.Delete
End If
Next
End Sub
Sub Tests_B()
Application.ScreenUpdating = False
Supprimer_Images Sheets("Feuil1"), msoPicture
End Sub
Private Sub Supprimer_Images(Feuille As Worksheet, TypeShp As MsoShapeType)
Dim shp As shape
On Error Resume Next
For Each shp In Feuille.Shapes
If shp.Type = TypeShp Then
shp.Delete
End If
Next
End Sub
Re,Re
Une version avec un second paramètre (qui parle de lui-même)
VB:Sub Tests_B() Application.ScreenUpdating = False Supprimer_Images Sheets("Feuil1"), msoPicture End Sub Private Sub Supprimer_Images(Feuille As Worksheet, TypeShp As MsoShapeType) Dim shp As shape On Error Resume Next For Each shp In Feuille.Shapes If shp.Type = TypeShp Then shp.Delete End If Next End Sub
Je l'ai fait, la première réponse ou la dernière ? Moi j'ai pris les deux celui ci .Re
Dans mon exemple, peu importe le module, normalement, il suffit de lancer la macro Tests_B
(Mais il faut que dans le module il y ait tout le code VBA présent dans le message#7)
Et il faut que le nom de la feuille soit celui d'une feuille existante.
Sub Tests_B()
Application.ScreenUpdating = False
Supprimer_Images Sheets("Feuil1"), msoPicture
End Sub
Private Sub Supprimer_Images(Feuille As Worksheet, TypeShp As MsoShapeType)
Dim shp As shape
On Error Resume Next
For Each shp In Feuille.Shapes
If shp.Type = TypeShp Then
shp.Delete
End If
Next
End Sub
Sub Création_Test()
Dim i&, shp As Shape
Application.ScreenUpdating = False
[A1:E5] = "=ADDRESS(ROW(),COLUMN(),4)": [A1:E5] = [A1:E5].Value: [A1].CurrentRegion.Columns.AutoFit
For i = 1 To 3
Cells(1).CurrentRegion.Font.Color = Choose(i, vbWhite, vbYellow, vbYellow)
Cells(1).CurrentRegion.Interior.Color = RGB(i * 84, 0, i * 12)
Cells(1).CurrentRegion.Copy
Range("D2").Offset(i * 5, i * 2).Select
ActiveSheet.Pictures.Paste
Next
Set shp = ActiveSheet.Shapes.AddShape(17, 312, 34.5, 177, 169.5): [C3].Select
End Sub