XL 2013 renomer image par rapport à la ceulule a coté

[jeromeN95]

Bonjour,
je souhaiterai adapté ce code :

Sub aa()
Dim S As Shape
Dim R As Range
For Each S In ActiveSheet.Shapes
  If S.Type = msoPicture Then
    Set R = S.TopLeftCell
    Set R = R.Offset(0, -1)
    S.Name = R
  End If
Next S
End Sub

pourrais je avoir l'adaptation pour uniquement la plage B3:B157

Les images sont en colonnes B, les noms en C svp?

 

[patricktoulon]

re
bonjour
uniquement les shapes qui sont dans B3:B157

Sub aa()
Dim S As Shape, R As Range
For Each S In ActiveSheet.Shapes
  If S.Type = msoPicture Then
    Set R = S.TopLeftCell.Offset(0, -1)
   If Not Intersect([B3:B157], R) Is Nothing Then S.Name = R
  End If
Next S
End Sub

 

[jeromeN95]

Bonjour PatrickToulon,
je te remercie.

J'ai du faire une boulette car ça ne fonctionne pas.

J'ai mis un icone, associé à la macro, mais pas de modifie.

Je joint un fichier au cas où. Merci. ;-)

 

[job75]

Bonjour,

Sub nomimage()
Dim S As Shape, R As Range
For Each S In ActiveSheet.Shapes
    Set R = S.TopLeftCell
    If Not Intersect([B3:B157], R) Is Nothing And R.Offset(, 1) <> "" Then S.Name = R.Offset(, 1)
Next
End Sub

Une Shape sera renommée si sa TopLeftCell est bien dans B3:B157, un petit déplacement de l'image peut la mettre en dehors...

A+

 

[jeromeN95]

Bonjour,
c'est géniale.
Ca fonctionne et je comprend pourquoi.

Un énorme merci job75.
Bravo.