Suppression image et forme dans plage définie

[Jacques25]

Bonjour à tous,

j'ai un petit soucis concernant la suppression des images et autres formes (flèches, figure géométrique, zone de texte...) sur une plage donnée.

Par exemple je souhaiterai supprimer tout ça sur la plage A15 à Z37 comment puis je faire tout ça simplement en VBA? Hors de cette plage j'ai d'autres éléments que je ne veux pas effacer...
J'ai bien essayé l'enregistrement de macro en auto mais il indique le nom de l'image ou de la forme qui dans mon cas ne sont jamais les mêmes.

Merci pour votre aide.

Jacques

 

[BOISGONTIER]

Re : Suppression image et forme dans plage définie

Bonjour,

Sub EffaceMentShapeChamp()
  For Each s In ActiveSheet.Shapes
    If Not Intersect(s.TopLeftCell, Range("$A$1:$D$20")) Is Nothing Then
       s.Delete
    End If
  Next s
End Sub

JB
Formation Excel VBA JB

 

[Jacques25]

Re : Suppression image et forme dans plage définie

Salut JB

Merci pour ton aide a priori ça marche, la première fois ça a beugué mais ça à l'air d'être OK

@ plus

Jacques

 

[Jacques25]

Re : Suppression image et forme dans plage définie

Bonjour JB, le forum,

Je rencontre un ptit soucis suite à l'utilisation de cette macro. Quand je l'utilise seule ça va très bien mais dès que j'insère le code dans une autre macro j'ai un message d'erreur, est ce que qqun peut m'aider?

J'ai fais de la sorte :

Public sub....
....
....
For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, Range("$A$1:$D$20")) Is Nothing Then
s.Delete
End If
Next s
...
...
End sub


Merci à tous

Jacques

 

[Jacques25]

Re : Suppression image et forme dans plage définie

Salut,

Merci pour ton coup de main mais ça ne change rien, l'erreur se trouve sur la ligne :
If no intersect...

si ça peut aider

Merci

 

[Jacques25]

Re : Suppression image et forme dans plage définie

Bonjour à tous,

Je reviens sur le sujet que j'avais un peu abandonner par manque de temps, le sujet est toujours d'actualité, le code qui à priori marche avec d'autre macro me donne une erreur dans le code ci dessous (épuré au maximum)
Le code erreur renvoyé est "erreur d'execution 1004 erreur définie par l'application ou par l'objet"
Erreur toujours sur la ligne : If no intersect...

Pour simplifier le code j'ai mis '... à chaque fois que les lignes avant et après étaient les mêmes.

Merci pour votre aide.

Jack

Public Sub CommandButtonrecopiereclamation_Click()

' déclaration des variables ENREGISTREMENT

Dim NOMFOURNISSEUR, NGAQannee, NREFERENCE, nbreannuellereclam, NGAQmois, NGAQnumero, NGAQservice, NGAQ, NGAQtraversant, NGAQRECC

NOMFOURNISSEUR = Range("AA3")
NGAQannee = Format(Date, "yy")
NGAQmois = Format(Date, "mm")
NGAQnumero = Format(Range("AO2"), "000")
NGAQservice = Range("AR2")
NGAQtraversant = Range("AU2")
NGAQRECC = Range("BH3")
NREFERENCE = Range("N6")
NGAQ = NGAQannee & NGAQmois & NGAQnumero & NGAQservice

'suppression filtres
Sheets("réclamation").Select
Rows("2:2").AutoFilter
Rows("2:2").AutoFilter
Sheets("Réclam Qualité").Select


'lecture des données
Sheets("Réclam Qualité").Activate

nbreannuellereclam = Range("BH2")
datereclam = Range("U4")
'annee = Range("bi1")
mois = Range("AM2")
NGAQ = Format(Range("AK2"), "00") & Format(Range("AM2"), "00") & Format(Range("AO2"), "000") & Range("AR2")
service = Range("ar2")
'...
copie = Range("F52")

'recopie des données sur données
Sheets("Réclamation").Activate
noligne = Range("A6").End(xlDown).Row + 1

Cells(noligne, 1) = nbreannuellereclam
Cells(noligne, 2) = datereclam
'...
Cells(noligne, 54) = copie
Cells(noligne, 66) = recurrence
Cells(noligne, 67) = sécurité

'recopie des formules

noligne = Range("A6").End(xlDown).Row + 1

Range(Cells(noligne - 2, 3), Cells(noligne - 2, 4)).Copy
Cells(noligne - 1, 3).Select
ActiveSheet.Paste

'...
Cells(noligne - 2, 62).Copy
Cells(noligne - 1, 62).Select
ActiveSheet.Paste

Application.CutCopyMode = False

'enregistrement FICHIER RECLAMATION

Dim chemin1$
Dim chemin2$
Dim chemin3$


chemin1 = "\\Chemin ou se trouve les enregistrement
chemin2 = NOMFOURNISSEUR
chemin4 = "\\Chemin ou se trouve les enrgistrement
chemin3 = "\" & NGAQ

If Dir(chemin1 & chemin2, 16) = "" Then MkDir chemin1 & chemin2
If Dir(chemin3 & chemin4, 16) = "" Then MkDir chemin4 & chemin3

Sheets("Réclam Qualité").Copy
ActiveWorkbook.SaveAs Filename:="Chemin où enregistrer le fichier


'effacement cellule

ThisWorkbook.Activate

Sheets("Réclam Qualité").Activate

For Each s In Sheets("Réclam Qualité").Shapes
If Not Intersect(s.TopLeftCell, Range("$A$16:$BG$37")) Is Nothing Then
s.Delete
End If
Next s

Sheets("Réclam Qualité").Activate

Cells(2, 48) = ""
Cells(2, 49) = ""
...
Cells(6, 60) = ""
Cells(7, 60) = ""


'fixation numéro GAQ

Cells(2, 37) = NGAQannee
Cells(2, 39) = NGAQmois
Cells(2, 44) = "QF"

NGAQnumero = NGAQnumero + 1
Cells(2, 41) = NGAQnumero

Dim nom, nom1

'sauvegarde

nom1 = "\\Chemin d'enregistrement
ActiveWorkbook.SaveCopyAs nom1

'copie

'nom = "Chemin d'enregistrement
ActiveWorkbook.SaveCopyAs nom

Sheets("Réclamation").Activate

End Sub

 

[Pierrot93]

Re : Suppression image et forme dans plage définie

Bonjour,

si le code est placé dans le module d'une autre feuille :

Sheets("Réclam Qualité").Activate

For Each s In Sheets("Réclam Qualité").Shapes
If Not Intersect(s.TopLeftCell, Sheets("Réclam Qualité").Range("$A$16:$BG$37")) Is Nothing Then

bonne journée
@+

 

[Jacques25]

Re : Suppression image et forme dans plage définie

Salut Pierrot, le forum,

Je viens de faire la modif et j'ai toujours le même problème.
Juste une ptite chose qui peut aider dans la réflexion, le fichier est utilisé sur excel 2003 et sur excel 2010 (le défaut est le même dans les 2 cas)...

Merci

 

[Pierrot93]

Re : Suppression image et forme dans plage définie

Re,

pas d'autre idée... sans pouvoir tester difficile d'en dire plus....

bon courage

 

[Jacques25]

Re : Suppression image et forme dans plage définie

Re,

Merci quand même, je vais essayer de réduire mon fichier au minimum pour essayer de le passer, sinon je ferai sans...

@ plus

Jack