Microsoft 365 Déplacement Shape

Cédric06400

XLDnaute Junior
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.
1728237917172.png

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
1728238136831.png

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
 
Solution
Bonsoir le fil

@Cédric06400
A adapter à tes besoins
VB:
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

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

@Cédric06400
A adapter à tes besoins
VB:
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

XLDnaute Junior
Bonsoir le fil

@Cédric06400
A adapter à tes besoins
VB:
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.
;)
 

Discussions similaires

Statistiques des forums

Discussions
314 996
Messages
2 115 165
Membres
112 340
dernier inscrit
smnk.4k