Microsoft 365 Déplacement Shape

[Cédric06400]

Bonjour à tous,

J'ai créer un macro qui permet de déplacer une image sélectionnée dans une feuille de calculs.
J'ai un MsgBox qui s'affiche si avant de lancer la macro aucune image est sélectionnée.

Ca tourne très bien

Sub DéplacImage1()

Dim Img As Excel.Picture
Dim Cel As Integer

Cel = 117

If Not TypeOf Selection Is Excel.Picture Then
MsgBox "Veuillez selectionner une image", vbCritical, "DéplacImage1"
Exit Sub: End If
Set Img = Selection

Selection.Cut
Range("A" & Cel).Select
ActiveSheet.Paste
Set Img = Selection
Img.Top = Range("A" & Cel).Top + 22
Img.Left = Range("A" & Cel).Left + 2
Selection.ShapeRange.IncrementLeft -16
End Sub

Je veux créer un macro similaire pour déplacer des AutoShape par dessus les photos précédemment déplacées
J'utilise des autoshape pour pouvoir les lier avec le contenu d'une cellule, un autoshape n'a pas de nom

Le hic c'est que je n'arrive pas à créer le MsgBox avec le shape sélectionné

Sub DeplaceShape()

Dim Cel As Integer
Cel = 117

' If Not TypeOf Selection Is Shape Then
' MsgBox "Veuillez selectionner une anomalie", vbCritical, "DeplaceShape"
' Exit Sub: End If

Selection.Cut
Range("A" & Cel).Select
ActiveSheet.Paste
Selection.ShapeRange.Top = Range("A" & Cel).Top + 22
Selection.ShapeRange.Left = Range("A" & Cel).Left + 2
Selection.ShapeRange.IncrementLeft -16
End Sub

Je nes uis pas certains qu'on puisse le faire avec la meme methode.

Pourriez vous m'aider ?

Bien à vous

Cédric

 

[Staple1600]

Bonsoir le fil

@Cédric06400
A adapter à tes besoins

Sub Test_AutoShape()
    Dim shp As Shape, obj As Object
    On Error Resume Next
    Set obj = Selection.ShapeRange(1)
    If obj Is Nothing Then
        MsgBox "Aucune forme n'est sélectionnée!", vbCritical
    Else
        For Each shp In ActiveSheet.Shapes
            If shp Is obj Then
                MsgBox "Nom de forme sélectionnée: " & shp.Name, vbInformation
            End If
        Next
    End If
End Sub

Pour tester, insère une forme, sélectionne-la puis lance la macro
puis sélectionne une cellule et relance la macro

 

[Cédric06400]

Bonsoir le fil

@Cédric06400
A adapter à tes besoins

Sub Test_AutoShape()
    Dim shp As Shape, obj As Object
    On Error Resume Next
    Set obj = Selection.ShapeRange(1)
    If obj Is Nothing Then
        MsgBox "Aucune forme n'est sélectionnée!", vbCritical
    Else
        For Each shp In ActiveSheet.Shapes
            If shp Is obj Then
                MsgBox "Nom de forme sélectionnée: " & shp.Name, vbInformation
            End If
        Next
    End If
End Sub

Pour tester, insère une forme, sélectionne-la puis lance la macro
puis sélectionne une cellule et relance la macro

Hello,
Merci pour ton retour rapide, c'est parfait.