Microsoft 365 Copier coller une feuille dans le même classeur contenant des shapes

[pat66]

Bonjour le forum,

lorsque on fait un copier coller d'une feuille dans le même classeur, les shapes sont automatiquement renommées sur la nouvelle feuille

est t'il possible de faire en sorte que les macros tiennent compte de ces nouveaux noms ou faut il les modifier une par une ?

merci

 

[sousou]

Bonjour.
C'est un peu vague sans fichiers, mai cela dépend de ce que font les macros, en principe ça devrait le faire

 

[Eric KERGRESSE]

Bonjour à tous,

Logiquement avec un simple copier-coller, les formes dupliquées portent le même nom.
Faites l'essai avec ce code pour recenser vos formes après un copier-coller :

Sub TestRechercherDimensionsShape()
       
Dim ShShapes As Worksheet, ShRapport As Worksheet
Dim ShapeRecherche As Shape
Dim AireShapes As Range
Dim LigneEnCours As Long

    Set ShShapes = Sheets("Feuil4") ' A adapter
    Set ShRapport = Sheets.Add(after:=ShShapes)
   
        With ShRapport
             .Range(.Cells(1, 1), .Cells(1, 5)) = Array("Forme", "Longueur", "Hauteur", "Angle", "Nom")
             LigneEnCours = 2
             For Each ShapeRecherche In ShShapes.Shapes
                 With ShRapport.Cells(LigneEnCours, 1)
                      .Value = ShapeRecherche.AutoShapeType
                      .Offset(0, 1) = ShapeRecherche.Width
                      .Offset(0, 2) = ShapeRecherche.Height
                      .Offset(0, 3) = ShapeRecherche.Rotation
                      .Offset(0, 4) = ShapeRecherche.Name
                      LigneEnCours = LigneEnCours + 1
                 End With
             Next ShapeRecherche
           
             Set AireShapes = .Range("A1").CurrentRegion
           
            .Sort.SortFields.Clear
            .Sort.SortFields.Add2 Key:=AireShapes.Columns(5), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange AireShapes
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With

        End With
       
        Set ShRapport = Nothing: Set ShShapes = Nothing:  Set AireShapes = Nothing
       
End Sub