Suppression d'objets

Le
jpierrethillard
Bonjour,

J'ai une macro qui fonctionne jusqu'à l'instant où je demande une
suppression d'objets.
J'ajoute que dans chaque feuille on retrouve les mêmes objets et même
nombre. Je souhaite les supprimer car ce sont des boutons avec liens
hypertexte ou déclencheur de macro.

Quelqu'un saurait me dire ce qu'il faut modifier pour éliminer le bug?

Merci d'avance.
JP

Voici la macro:

Sub archive()
Arr = Array("Inscription", "Situation Candidat", "Formation Candidat")
' au besoin ajoute des feuilles
Set tmp = ThisWorkbook ' classeur active
Application.SheetsInNewWorkbook = UBound(Arr)
Set wbk = Workbooks.Add ' nouveau classeur
For i = 1 To UBound(Arr)
wbk.Sheets(i).Name = Arr(i)
'Suppression d'objets avant sauvegarde
ActiveSheet.Shapes("groupe1").Delete
ActiveSheet.Shapes("groupe2").Delete
ActiveSheet.Shapes("Fauto1").Delete
Next i


For Each sh In Arr
'copie la plage utilisée de la feuille
tmp.Sheets(sh).UsedRange.Copy
'la colle dans la feuille du 2ème classeur
wbk.Sheets(sh).Paste
'vide le presse-papiers
Application.CutCopyMode = False
Next
End sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Misange
Le #5339281
Bonjour
Ne sachant pas quel est le bug et que veut dire "la macro fonctionne
jusqu'à..." (oui je sais je pinaille ;-) mais plus tu es précis plus les
réponses le sont !)
Quand on supprime des objets dans une collection, il faut partir de la
fin et remonter sinon l'index des objets (leur N° d'odre dans la
collection) change au fur et à mesure des suppressions et fatalement ça
met le bazar.
for i= ubound(machin) to 1 step-1
...
next i
devrait être mieux

Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Bonjour,

J'ai une macro qui fonctionne jusqu'à l'instant où je demande une
suppression d'objets.
J'ajoute que dans chaque feuille on retrouve les mêmes objets et même
nombre. Je souhaite les supprimer car ce sont des boutons avec liens
hypertexte ou déclencheur de macro.

Quelqu'un saurait me dire ce qu'il faut modifier pour éliminer le bug?

Merci d'avance.
JP

Voici la macro:

Sub archive()
Arr = Array("Inscription", "Situation Candidat", "Formation Candidat")
' au besoin ajoute des feuilles
Set tmp = ThisWorkbook ' classeur active
Application.SheetsInNewWorkbook = UBound(Arr)
Set wbk = Workbooks.Add ' nouveau classeur
For i = 1 To UBound(Arr)
wbk.Sheets(i).Name = Arr(i)
'Suppression d'objets avant sauvegarde
ActiveSheet.Shapes("groupe1").Delete
ActiveSheet.Shapes("groupe2").Delete
ActiveSheet.Shapes("Fauto1").Delete
Next i


For Each sh In Arr
'copie la plage utilisée de la feuille
tmp.Sheets(sh).UsedRange.Copy
'la colle dans la feuille du 2ème classeur
wbk.Sheets(sh).Paste
'vide le presse-papiers
Application.CutCopyMode = False
Next
End sub


MichDenis
Le #5339271
Ta question n'est pas très claire !

Si tu veux former un nouveau classeur à partir de ces
noms de feuilles du classeur actuel, à partir d'une macro
dans le classeur actuel et faire disparaître tous les objets
dans les feuilles du nouveau classeur, il me semble que
ceci serait suffisant :

'-------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candidat")).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In Worksheets
sh.DrawingObjects.Delete
Next
End With

End Sub
'-------------------------
MichDenis
Le #5339261
Il manque un "point" (.) devant Worksheets dans cette ligne
de code : For Each sh In Worksheets dans la procédure
soumise


"MichDenis" %
Ta question n'est pas très claire !

Si tu veux former un nouveau classeur à partir de ces
noms de feuilles du classeur actuel, à partir d'une macro
dans le classeur actuel et faire disparaître tous les objets
dans les feuilles du nouveau classeur, il me semble que
ceci serait suffisant :

'-------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candidat")).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In Worksheets
sh.DrawingObjects.Delete
Next
End With

End Sub
'-------------------------
jpierrethillard
Le #5338901
Bonsoir MichDenis,

Désolé de ne repondre que tardivement, j'ai fait un break sportif.

J'ai dit des bétises tout à l'heure dans mon premier post. Je viens de
le constater. Je mettais les 3 lignes suivantes dans la boucle de
création de feuilles.

'Suppression d'objets et données avant sauvegarde
ActiveSheet.Shapes("groupe1").Delete
ActiveSheet.Shapes("groupe2").Delete
ActiveSheet.Shapes("Fauto1").Delete

Je viens de tester ta macro que tu m'as soumis pour la suppression des
objets. Elle est efficace. Un peu trop si je puis dire car elle
n'épargne rien. En fait je ne veux supprimer que trois objets sur les
trois feuilles.
Les objets se nomment groupe1, groupe2 et FAuto1.
Je ne sais pas où placer ces trois lignes pour qu'elles soient
efficaces sur les trois feuilles ( Inscription, Situation Candidat,
Formation candidat).
Dans la macro en debut de fil, je donne la macro complète qui permet
de créer le classeur avec les 3 feuilles.

1) Est-ce que ces lignes conviennent?
'Suppression d'objets et données avant sauvegarde
ActiveSheet.Shapes("groupe1").Delete
ActiveSheet.Shapes("groupe2").Delete
ActiveSheet.Shapes("Fauto1").Delete
2) Où dois-je les placer pour supprimer les objets.

Merci encore!
JP



On 5 jan, 16:23, "MichDenis"
Il manque un "point" (.) devant Worksheets dans cette ligne
de code :    For Each sh In Worksheets    dans la procédure
soumise

"MichDenis" %
Ta question n'est pas très claire !

Si tu veux former un nouveau classeur à partir de ces
noms de feuilles du classeur actuel, à partir d'une macro
dans le classeur actuel et faire disparaître tous les objets
dans les feuilles du nouveau classeur, il me semble que
ceci serait suffisant :

'-------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candidat" )).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
    For Each sh In Worksheets
        sh.DrawingObjects.Delete
    Next
End With

End Sub
'-------------------------


MichDenis
Le #5338871
Essaie comme ceci :

'---------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candidat")).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In .Worksheets
sh.Shapes("groupe1").Delete
sh.Shapes("groupe2").Delete
sh.Shapes("Fauto1").Delete
Next
End With

End Sub
'---------------------------



Bonsoir MichDenis,

Désolé de ne repondre que tardivement, j'ai fait un break sportif.

J'ai dit des bétises tout à l'heure dans mon premier post. Je viens de
le constater. Je mettais les 3 lignes suivantes dans la boucle de
création de feuilles.

'Suppression d'objets et données avant sauvegarde
ActiveSheet.Shapes("groupe1").Delete
ActiveSheet.Shapes("groupe2").Delete
ActiveSheet.Shapes("Fauto1").Delete

Je viens de tester ta macro que tu m'as soumis pour la suppression des
objets. Elle est efficace. Un peu trop si je puis dire car elle
n'épargne rien. En fait je ne veux supprimer que trois objets sur les
trois feuilles.
Les objets se nomment groupe1, groupe2 et FAuto1.
Je ne sais pas où placer ces trois lignes pour qu'elles soient
efficaces sur les trois feuilles ( Inscription, Situation Candidat,
Formation candidat).
Dans la macro en debut de fil, je donne la macro complète qui permet
de créer le classeur avec les 3 feuilles.

1) Est-ce que ces lignes conviennent?
'Suppression d'objets et données avant sauvegarde
ActiveSheet.Shapes("groupe1").Delete
ActiveSheet.Shapes("groupe2").Delete
ActiveSheet.Shapes("Fauto1").Delete
2) Où dois-je les placer pour supprimer les objets.

Merci encore!
JP



On 5 jan, 16:23, "MichDenis"
Il manque un "point" (.) devant Worksheets dans cette ligne
de code : For Each sh In Worksheets dans la procédure
soumise

"MichDenis" %
Ta question n'est pas très claire !

Si tu veux former un nouveau classeur à partir de ces
noms de feuilles du classeur actuel, à partir d'une macro
dans le classeur actuel et faire disparaître tous les objets
dans les feuilles du nouveau classeur, il me semble que
ceci serait suffisant :

'-------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candidat")).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In Worksheets
sh.DrawingObjects.Delete
Next
End With

End Sub
'-------------------------


jpierrethillard
Le #5338831
MichDenis,

J'en ai marre d'être désolé crois le bien!
Je ne m'en sors pas. Car je voudrais qu'en ouvrant le nouveau classeur
avec les 3 feuilles, les 3 objets aient disparu.
Je te soumets la macro complète pour que tu me donnes ton avis
éclairé.

Merci encore et encore!
JP
Option Base 1

Sub ArchiveFeuilles()
ActiveSheet.Unprotect Password:=""
If [E6] = "" Then
MsgBox "Aucune sauvegarde sans Nom, retournez à la page
inscription "
Sheets("Inscription").Select
[E8].Select
Exit Sub
End If
If [a12] = "" Then
MsgBox "Entrez le Nom et Prénom du CFC"
[a12].Select
Exit Sub
End If
répertoire = ActiveWorkbook.Path
Contrat = ([E6]) & ([G6]) & " contrat n°" & Format([i6], " 000")
'----------------------------------
Dim sh, wbk As Workbook, tmp As Workbook
arr = Array("Inscription", "Situation Candidat", "Formation Candidat")
' au besoin ajoute des feuilles
Set tmp = ThisWorkbook ' classeur active
Application.SheetsInNewWorkbook = UBound(arr)
Set wbk = Workbooks.Add ' nouveau classeur
For i = 1 To UBound(arr)
wbk.Sheets(i).Name = arr(i)
Next i
'-------------- Début sup MichDenis
'sub test()
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In .Worksheets

sh.Shapes("groupe1").Delete

sh.Shapes("groupe2").Delete

sh.Shapes("Fauto1").Delete
Next
End With

' End sub
' ---------------Fin sup MichDenis

For Each sh In arr
Worksheets(Array("Inscription", "Situation Candidat", "Formation
Candidat")).Copy


'copie la plage utilisée de la feuille
tmp.Sheets(sh).UsedRange.Copy
'la colle dans la feuille du 2ème classeur
wbk.Sheets(sh).Paste
'vide le presse-papiers
Application.CutCopyMode = False

Next
' ---------------------------------------
ActiveWorkbook.SaveAs Filename:=répertoire & "" & Contrat
MsgBox Contrat & " sauvegardé"
ActiveWorkbook.Close
Sheets("Formation candidat").Select
[i6] = [i6] + 1
ActiveWorkbook.Save
ActiveSheet.Protect Password:=""

End Sub

On 5 jan, 20:27, "MichDenis"
Essaie comme ceci :

'---------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candidat" )).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
    For Each sh In .Worksheets
        sh.Shapes("groupe1").Delete
        sh.Shapes("groupe2").Delete
        sh.Shapes("Fauto1").Delete
    Next
End With

End Sub
'---------------------------


Bonsoir MichDenis,

Désolé de ne repondre que tardivement, j'ai fait un break sportif.

J'ai dit des bétises tout à l'heure dans mon premier post. Je viens de
le constater. Je mettais les 3 lignes suivantes dans la boucle de
création de feuilles.

    'Suppression d'objets et données avant sauvegarde
            ActiveSheet.Shapes("groupe1").Delete
            ActiveSheet.Shapes("groupe2").Delete
            ActiveSheet.Shapes("Fauto1").Delete

Je viens de tester ta macro que tu m'as soumis pour la suppression des
objets. Elle est efficace. Un peu trop si je puis dire car elle
n'épargne rien. En fait je ne veux supprimer que trois objets sur les
trois feuilles.
Les objets se nomment groupe1, groupe2 et FAuto1.
Je ne sais pas où placer ces trois lignes pour qu'elles soient
efficaces sur les trois feuilles ( Inscription, Situation Candidat,
Formation candidat).
Dans la macro en debut de fil, je donne la macro complète qui permet
de créer le classeur avec les 3 feuilles.

1) Est-ce que ces lignes conviennent?
    'Suppression d'objets et données avant sauvegarde
            ActiveSheet.Shapes("groupe1").Delete
            ActiveSheet.Shapes("groupe2").Delete
            ActiveSheet.Shapes("Fauto1").Delete
2) Où dois-je les placer pour supprimer les objets.

Merci encore!
JP

On 5 jan, 16:23, "MichDenis"


Il manque un "point" (.) devant Worksheets dans cette ligne
de code : For Each sh In Worksheets dans la procédure
soumise

"MichDenis" %
Ta question n'est pas très claire !

Si tu veux former un nouveau classeur à partir de ces
noms de feuilles du classeur actuel, à partir d'une macro
dans le classeur actuel et faire disparaître tous les objets
dans les feuilles du nouveau classeur, il me semble que
ceci serait suffisant :

'-------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candida t")).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In Worksheets
sh.DrawingObjects.Delete
Next
End With

End Sub
'-------------------------- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



MichDenis
Le #5338821
Hé capitaine,

Ta question demandait de copier les feuilles mentionnées
vers un nouveau classeur et d'enlever les 3 shapes stipulées
dans chacune des feuilles du nouveau classeur.

J'ai la prétention de croire jusqu'à ce que tu m'indiques où ma
procédure se plante et le message d'erreur que tu as, qu'elle
fonctionne correctement.

La procédure proposée devrait remplacer tout ceci :
Ce que tu tests avant et après...ne fait pas parti de MA DONNE.
et je ne sais pas à quoi cela réfère ! À toi de jouer.

'---------------------------------------------
Dim sh, wbk As Workbook, tmp As Workbook
arr = Array("Inscription", "Situation Candidat", "Formation Candidat")
' au besoin ajoute des feuilles
Set tmp = ThisWorkbook ' classeur active
Application.SheetsInNewWorkbook = UBound(arr)
Set wbk = Workbooks.Add ' nouveau classeur
For i = 1 To UBound(arr)
wbk.Sheets(i).Name = arr(i)
Next i
'-------------- Début sup MichDenis
'sub test()
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In .Worksheets

sh.Shapes("groupe1").Delete

sh.Shapes("groupe2").Delete

sh.Shapes("Fauto1").Delete
Next
End With

' End sub
' ---------------Fin sup MichDenis

For Each sh In arr
Worksheets(Array("Inscription", "Situation Candidat", "Formation
Candidat")).Copy


'copie la plage utilisée de la feuille
tmp.Sheets(sh).UsedRange.Copy
'la colle dans la feuille du 2ème classeur
wbk.Sheets(sh).Paste
'vide le presse-papiers
Application.CutCopyMode = False

Next
'---------------------------------------------






MichDenis,

J'en ai marre d'être désolé crois le bien!
Je ne m'en sors pas. Car je voudrais qu'en ouvrant le nouveau classeur
avec les 3 feuilles, les 3 objets aient disparu.
Je te soumets la macro complète pour que tu me donnes ton avis
éclairé.

Merci encore et encore!
JP
Option Base 1

Sub ArchiveFeuilles()
ActiveSheet.Unprotect Password:=""
If [E6] = "" Then
MsgBox "Aucune sauvegarde sans Nom, retournez à la page
inscription "
Sheets("Inscription").Select
[E8].Select
Exit Sub
End If
If [a12] = "" Then
MsgBox "Entrez le Nom et Prénom du CFC"
[a12].Select
Exit Sub
End If
répertoire = ActiveWorkbook.Path
Contrat = ([E6]) & ([G6]) & " contrat n°" & Format([i6], " 000")
'----------------------------------
Dim sh, wbk As Workbook, tmp As Workbook
arr = Array("Inscription", "Situation Candidat", "Formation Candidat")
' au besoin ajoute des feuilles
Set tmp = ThisWorkbook ' classeur active
Application.SheetsInNewWorkbook = UBound(arr)
Set wbk = Workbooks.Add ' nouveau classeur
For i = 1 To UBound(arr)
wbk.Sheets(i).Name = arr(i)
Next i
'-------------- Début sup MichDenis
'sub test()
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In .Worksheets

sh.Shapes("groupe1").Delete

sh.Shapes("groupe2").Delete

sh.Shapes("Fauto1").Delete
Next
End With

' End sub
' ---------------Fin sup MichDenis

For Each sh In arr
Worksheets(Array("Inscription", "Situation Candidat", "Formation
Candidat")).Copy


'copie la plage utilisée de la feuille
tmp.Sheets(sh).UsedRange.Copy
'la colle dans la feuille du 2ème classeur
wbk.Sheets(sh).Paste
'vide le presse-papiers
Application.CutCopyMode = False

Next
' ---------------------------------------
ActiveWorkbook.SaveAs Filename:=répertoire & "" & Contrat
MsgBox Contrat & " sauvegardé"
ActiveWorkbook.Close
Sheets("Formation candidat").Select
[i6] = [i6] + 1
ActiveWorkbook.Save
ActiveSheet.Protect Password:=""

End Sub

On 5 jan, 20:27, "MichDenis"
Essaie comme ceci :

'---------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candidat")).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In .Worksheets
sh.Shapes("groupe1").Delete
sh.Shapes("groupe2").Delete
sh.Shapes("Fauto1").Delete
Next
End With

End Sub
'---------------------------


Bonsoir MichDenis,

Désolé de ne repondre que tardivement, j'ai fait un break sportif.

J'ai dit des bétises tout à l'heure dans mon premier post. Je viens de
le constater. Je mettais les 3 lignes suivantes dans la boucle de
création de feuilles.

'Suppression d'objets et données avant sauvegarde
ActiveSheet.Shapes("groupe1").Delete
ActiveSheet.Shapes("groupe2").Delete
ActiveSheet.Shapes("Fauto1").Delete

Je viens de tester ta macro que tu m'as soumis pour la suppression des
objets. Elle est efficace. Un peu trop si je puis dire car elle
n'épargne rien. En fait je ne veux supprimer que trois objets sur les
trois feuilles.
Les objets se nomment groupe1, groupe2 et FAuto1.
Je ne sais pas où placer ces trois lignes pour qu'elles soient
efficaces sur les trois feuilles ( Inscription, Situation Candidat,
Formation candidat).
Dans la macro en debut de fil, je donne la macro complète qui permet
de créer le classeur avec les 3 feuilles.

1) Est-ce que ces lignes conviennent?
'Suppression d'objets et données avant sauvegarde
ActiveSheet.Shapes("groupe1").Delete
ActiveSheet.Shapes("groupe2").Delete
ActiveSheet.Shapes("Fauto1").Delete
2) Où dois-je les placer pour supprimer les objets.

Merci encore!
JP

On 5 jan, 16:23, "MichDenis"


Il manque un "point" (.) devant Worksheets dans cette ligne
de code : For Each sh In Worksheets dans la procédure
soumise

"MichDenis" %
Ta question n'est pas très claire !

Si tu veux former un nouveau classeur à partir de ces
noms de feuilles du classeur actuel, à partir d'une macro
dans le classeur actuel et faire disparaître tous les objets
dans les feuilles du nouveau classeur, il me semble que
ceci serait suffisant :

'-------------------------
Sub test()

Worksheets(Array("Inscription", "Situation Candidat", "Formation Candidat")).copy
'Et pour faire disparaître toutes les "Shapes"
'dans le nouveau classeur
With ActiveWorkbook
For Each sh In Worksheets
sh.DrawingObjects.Delete
Next
End With

End Sub
'-------------------------- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



jpierrethillard
Le #5338811
MichDenis,

Oui tu as raison, je vais tenter d'organiser tout cela.

Merci encore et bonne fin de soirée.

JP
Publicité
Poster une réponse
Anonyme