Effacer une image dans une cellule

**retraite83** · 24/02/2021, 19h48

Bonjour,

dans une boucle je veux effacer l'image de la cellule "C" & i
J'ai donc insérer dans ma boucle le code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
For Each sh In imprim.Shapes
                    If sh.TopLeftCell.Address = Range("C" & i).Address Then
                        sh.Delete
                        Exit For
                    End If
Next

Sachant qu'il y 0 ou 1 seule image dans la cellule "C" & i je pense qu'il est possible d'optimiser ce bout de code

A mon sens

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each sh In imprim.Shapes

balaye toutes les images de la feuille

**Patrice740** · 24/02/2021, 22h08

Bonjour,

Il y a peut-être (surement) d'autres solutions mais avec un code aussi partiel impossible répondre.
EDIT : En principe, il devrait suffire de boucler sur les formes uniquement.

Il faut toujours fournir l'intégralité du code, éventuellement réduit à sa partie utile, mais complet depuis Sub jusqu'à End sub)

Invité · 25/02/2021, 04h40

Envoyé par retraite83

Bonjour,

Une solution consiste à comparer les propriétés Top et Left de la cellule et de la forme en tenant compte d'un écart dans le positionnement de la forme (par exemple -10 + 10 en vertical et en horizontal). Cela fonctionne très bien.
Une autre solution consiste à mettre l'adresse de la cellule dans le nom de la forme pour pouvoir la détruire par la suite en récupérant les coordonnées en splitant simplement le nom.

**retraite83** · 25/02/2021, 09h34

Bonjour,

en fait j' ai une boucle de mise en page dans ma feuille dont l'image (toujours la même), dépendant d'une valeur.

une fois la page préparée, j'édite un PDF et je passe à la suivante en effaçant l'image en fin de boucle (pour le cas où il n'y aurait pas d'image dans la boucle suivante)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
sh.Shapes("Image 4").Copy
 
For bcle = 1 to 50 
serv.Range("C" & k) = emoi Then
   ... ' mise en page de différentes cellules
 
    If serv.Range("E" & k) = yes Then
         sh.Range("C" &  i).Select
         sh.Paste
   Else
   End If
 
    ... ' PDF
 
    For Each sh In sh.Shapes
          If sh.TopLeftCell.Address = Range("C" & i).Address Then
                sh.Delete
                Exit For
 
   k = k +1
Next bcle

**Patrice740** · 25/02/2021, 10h44

Bonjour,

Envoyé par Patrice740

Il faut toujours fournir l'intégralité du code, éventuellement réduit à sa partie utile, mais complet depuis Sub jusqu'à End sub)

Ton second code est incompréhensible !!!
C'est quoi emoi, i, k ???? pourquoi 1 à 50 ?????

Un exemple sur la base de ton premier code :
Ce qui ressemble à ce que tu as fait mais complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
Sub test1()
Dim imprim As Worksheet, sh As Shape
Dim deb As Long, fin As Long, i As Long
 
  Set imprim = Worksheets(1)
  deb = 3
  fin = 80
  For i = deb To fin
    For Each sh In imprim.Shapes
      If sh.TopLeftCell.Address = Range("C" & i).Address Then
        sh.Delete
        Exit For
      End If
    Next sh
  Next i
 
End Sub

Ce qu'il suffit de faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test2()
Dim imprim As Worksheet, sh As Shape
Dim deb As Long, fin As Long
 
  Set imprim = Worksheets(1)
  deb = 3
  fin = 80
  For Each sh In imprim.Shapes
    If sh.TopLeftCell.Column = 3 And _
       sh.TopLeftCell.Row >= deb And _
       sh.TopLeftCell.Row <= fin Then sh.Delete
  Next sh
 
End Sub

**retraite83** · 25/02/2021, 11h19

Bonjour Patrice,

si je comprends bien ton code adapté ci-après permet de ne balayer que les lignes utiles (200 à 600) au lieu de toutes les lignes de la feuille et uniquement pour la colonne C (où il y a l'image)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub test2()
Dim imprim As Worksheet, sh As Shape
Dim deb As Long, fin As Long, col as integer
 
  Set imprim = Sheets(Imprim)
  col = 3
  deb = 200
  fin = 600
  For Each sh In imprim.Shapes
    If sh.TopLeftCell.Column = col And _
       sh.TopLeftCell.Row >= deb And _
       sh.TopLeftCell.Row <= fin Then sh.Delete
  Next sh
 
End Sub

Sachant que l'image se trouve en ligne 200 modulo 8 (c'est à dire toutes les 8 lignes en "C200" puis "C208" puis "C216") il y a peut être un moyen encore plus rapide de n'adresser que ces cellules

**Patrice740** · 25/02/2021, 18h17

Re,

Envoyé par retraite83

si je comprends bien ton code adapté ci-après permet de ne balayer que les lignes utiles (200 à 600) au lieu de toutes les lignes de la feuille et uniquement pour la colonne C (où il y a l'image)

Absolument pas !!!!
Ce code ne balaye aucune ligne : il balaye toutes les formes (image ou autres).

Seule la solution d'Eric, inclure l'adresse de la cellule dans le nom de l'image, permettrait d'identifier l'image associée à une cellule et donc de balayer les lignes avec un pas de 8 sans devoir chercher laquelle des images se trouve sur cette cellule.
Mais dans ce cas, si on déplace une image sur une autre cellule il faut modifier son nom.

**retraite83** · 25/02/2021, 18h29

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Ce code ne balaye aucune ligne : il balaye toutes les formes (image ou autres).

Oui c'est ce que je voulais dire... beaucoup de mal à m'habituer à tout ce vocabulaire de précision..

Le résultat est un peu long mais ça marche très bien. comme il s'agit d'une édition occasionnelle d'un catalogue, cela n'a pas énormément d'importance, il suffit de le lancer un soir.

Je vais me contenter de cette solution

Merci à vous 2