Copier et renommer plusieurs images

Bonjour le Forum,
Dans mon fichier j’ai 150 images nommé Rectangle 1 à Rectangle 150.
Je suis sous Excel 2019 : Insertion Formes puis rectangle et j’ai ensuite insérer à l’intérieur une image.
Je voudrais copier toutes les images et les renommer pour avoir Rectangle 151 à Rectangle 300.
J’ai bien fait copier coller d’un Rectangle mais cela ne change pas le numéro de l’image.
Est-il possible de faire cette demande automatiquement ou bien suis-je obligé de le faire manuellement une par une.
Bonne journée au Forum.
Merci d’avance pour vos réponse.
PJ87

Bonjour

ces lignes de code sont à essayer :

i = 151
For Each Sh In ActiveSheet.Shapes
Sh.Name = "Rectangle " & i
i = i + 1
Next

Attention ressaisir au clavier les guillemets comme ceci :

Testes et dis moi

Bonjour FFO,
J’ai tester sur mes 150 Rectangle et j’ai eu un message d’erreur.
Erreur d’exécution ‹ 6 ›:
Dépassement de capacité
et en jaune
i = i + 1
Don j’ai tester sur 20 Rectangle et cela à bien fonctionner mais le résultats est un peu mélanger.
J’ai Rectangle 152 151 170 etc.
Est il possible qu’ils soient ranger par ordre : 151 152 153 154 etc.
Merci pour ton aide
PJ87

Tes rectangles ont ils un nom d’origine progressif et de quelle manière (nom indice)

Pour le dépassement de capacité peut être qu’un seul onglet ne peut accepter un nombre d’images maximum limités

Merci pour les précisions sinon me transmettre ton fichier avec les images d’origine

Re,
Nombre d’images accepter 160, je ne peux en mettre plus.
Merci de ton aide et
bonne après midi à toi et au Forum.

PJ87

Merci pour ton retour quelque peu partiel

Tu ne m’as pas répondu sur ce point :

Tes rectangles ont ils un nom d’origine progressif et de quelle manière (nom indice)

Peut être en fonction s’appuyer sur leur progression dans leur appellation pour ordonner correctement le nouveau nom

A toi de voir et me dire

AI7 correspondance avec Rectangle 1
AI8 correspondance avec Rectangle 2


AI156 correspondance avec Rectangle 150

La colonne AI effectue un tri et les images suivent.
Les images sont stocker dans le dossier Listes
Code VBA

Private Sub traitementImages()
If [AI7] <> «  » Then
image = ActiveWorkbook.Path & « \Listes » & [AI7] & « .jpg »
Shapes(« Rectangle 1 »).Fill.Visible = msoTrue
Shapes(« Rectangle 1 »).Fill.UserPicture image
Else
Shapes(« Rectangle 1 »).Fill.Visible = msoFalse
End If

    If [AI8] <> "" Then
        image = ActiveWorkbook.Path & "\Listes\" & [AI8] & ".jpg"
        Shapes("Rectangle 2").Fill.Visible = msoTrue
        Shapes("Rectangle 2").Fill.UserPicture image
    Else
        Shapes("Rectangle 2").Fill.Visible = msoFalse
    End If
    ...
    If [AI156] <> "" Then
        image = ActiveWorkbook.Path & "\Listes\" & [AI156] & ".jpg"
        Shapes("Rectangle 150").Fill.Visible = msoTrue
        Shapes("Rectangle 150").Fill.UserPicture image
    Else
        Shapes("Rectangle 150").Fill.Visible = msoFalse
    End If

PJ87

Utilise ces lignes de code en remplacement de celles que je t’ai données :

For Each sh In ActiveSheet.Shapes
If UBound(Split(sh.Name, "Rectangle ")) > 0 Then
nom = "Rectangle " & Split(sh.Name, "Rectangle ")(1) + 150
sh.Name = nom
End If
Next

comme ceci :

Avec ces lignes seules toutes les images dont le nom commence par "Rectangle "

seront renommée avec le même nom et l’indice qui suit additionné à 150

Exemple :

Shapes(« Rectangle 2 »)

renommé

Shapes(« Rectangle 152 »)

Ainsi de suite

Testes et dis moi

Super merci beaucoup
Cela fonctionne super bien
Bonne soirée à toi et au Forum
PJ87

Merci de ton retour
Ravi que cela te convienne
A ta disposition si besoin
Au plaisir

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.