XL 2010 Supprimer toutes les images d'un onglet en particulier afin d'alléger le classeur ?

[anthoYS]

Bonjour,

Ce serait trop long un par un. Surtout qu'il est nécessaire de faire un clic droit puis de sélectionner avec clic gauche puis suppr.
Enfin, il y en a beaucoup trop j'ai copier une liste et ça m'a copié toutes les images...

Merci par avance

 

[Staple1600]

Bonjour le fil,

anthoYS
Ce genre de code est disponible dans les archives du forum
Il suffit de chercher

Effectuez une recherche sur Excel Downloads...

www.excel-downloads.com

(mais tu sais déjà cela, vu ton ancienneté sur le forum )

 

[anthoYS]

Merci @Staple1600 mais je n'ai rien trouvé de correspondant à ma demande.

 

[Staple1600]

Re

En cherchant bien, on pouvait par un heureux hasard tomber sur cette discussion

https://www.excel-downloads.com/threads/suppression-de-shape.231764/page-2#post-1480897

S'en inspirer (en inversant la logique)
Tu vois comment faire?

 

[anthoYS]

Re

En cherchant bien, on pouvait par un heureux hasard tomber sur cette discussion

https://www.excel-downloads.com/threads/suppression-de-shape.231764/page-2#post-1480897

S'en inspirer (en inversant la logique)
Tu vois comment faire?

J'avoue être perdu.

Shapes ce sont pas les images non ?

 

[Staple1600]

Re

Donc, je viens d'adapter mon propre code
(Qu'est ce que le confinement nous fait pas 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

Insère des images sur une feuille nommée Feuil1 puis lance la macro.

 

[Staple1600]

Re

Une version avec un second paramètre (qui parle de lui-même)

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

 

[anthoYS]

Re

Une version avec un second paramètre (qui parle de lui-même)

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,

Ok je l'ai fait j'ai renommé la feuille par la bonne, mais ça ne fait rien, je l'ai mise dans l'onglet en VB. Sinon je ne sais pas exécuter un code VB en dehors de la feuille. En macro peut être ?

Désolé, je n'y parviens pas.

 

[anthoYS]

Comme j'ai 5 modules, je ne sais pas dans quel module ça va ...

 

[Staple1600]

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.

 

[anthoYS]

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.

Je l'ai fait, la première réponse ou la dernière ? Moi j'ai pris les deux celui ci .

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

 

[anthoYS]

ça marche, un grand merci !

 

[Staple1600]

Re

Je t'avais préparé une petite macro pour test
(Vu que c'est fait, je poste)
Ça pourra toujours servir à ceux qui passeront dans ton fil, et voudront tester.
NB: A tester sur un classeur vierge avec une feuille nommée: Feuil1

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

Une fois cette macro lancée, copiez tout le code du message#5 dans le même module et lancer la macro nommée Test_B
Seules les images seront supprimées.