Objets dans des feuilles...

  • Initiateur de la discussion Initiateur de la discussion Baroude
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

B

Baroude

Guest
Bonjour à tous et à toutes,

J'aurai besoin de votre aide...
Quelqu'un aurai t-il un code VBA permettant de renvoyer dans une feuille Excel tous les noms des objets contenus dans le classeur (graphique, zone de texte etc...)

Merci de votre aide
Bonne aprèm'
Baroude
 
Bonsoir Baroude et toi le Forum,

Tiens j'ai trouvé ce code d'Alain Vallon sur MPFE, qui permet de lister tous les objets et graphiques présents sur une feuille...

Sub Lister_Objets()

Application.ScreenUpdating = False
Set Zone = ActiveSheet
On Error Resume Next
Nomfeuil = "Liste objets de " & ActiveSheet.Name
Worksheets.Add.Name = Nomfeuil
With Sheets(Nomfeuil)
.UsedRange.Clear
.[A1] = "Nom de l'objet"
.[B1] = "Type d'objet"
.[C1] = "Macro affectée"
.[D1] = "Texte"
.[E1] = "Adresse"
.[F1] = "Gauche"
.[G1] = "Haut"
.[H1] = "Largeur"
NbObjet = Zone.DrawingObjects.Count
For Each objet In Zone.DrawingObjects
Cpte = Cpte + 1
Application.StatusBar = "Récup à " & _
Format(Cpte / NbObjet, "0%") & " réalisée"
lgn = .[A65536].End(xlUp).Row
.[A1].Offset(lgn) = objet.Name
.[B1].Offset(lgn) = TypeName(objet)
.[C1].Offset(lgn) = objet.OnAction
.[D1].Offset(lgn) = objet.Characters.Text
If .[D1].Offset(lgn) = "#N/A" Then .[D1].Offset(lgn).Value = ""
.[E1].Offset(lgn) = objet.TopLeftCell.Address
.[F1].Offset(lgn) = objet.Left
.[G1].Offset(lgn) = objet.Top
.[H1].Offset(lgn) = objet.Width
Next
Application.StatusBar = False
.Columns("A:H").AutoFit
.Activate
End With

End Sub

A+Veriland.gif


PS : Macro à copier depuis le forum auquel cas tu risques d'avoir les attributs GRAS du post dedans
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
5
Affichages
377
Retour