Sub Test()
    MsgBox Application.Caller
End Sub

MsgBox ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text

Sub PositionFormeAutomatique()
    Dim Shp As Shape
 
    'Spécifie la 1ere forme dans la Feuil1
    Set Shp = Feuil1.Shapes(1)
    MsgBox Shp.TopLeftCell.Address & ":" & Shp.BottomRightCell.Address
End Sub

'Ajoute une forme automatique (Rectangle) dans la feuille
    'Position horizontale - Left = 40
    'Position verticale - Top = 80
    'Largeur - Width = 140
    'Hauteur - Height = 50
With Worksheets("Feuil1").Shapes.AddShape(msoShapeRectangle, 40, 80, 140, 50)
    .Name = "NomForme"
    .TextFrame.Characters.Text = "Le texte dans la forme"
End With

Dim Obj As Shape
 
'Compte le nombre de formes dans la feuille
MsgBox "Nombre de formes dans la feuille: " & Worksheets("Feuil1").Shapes.Count
 
'Boucle sur les formes contenues dans la feuille
For Each Obj In Worksheets("Feuil1").Shapes
    Select Case Obj.Type
        '--- MsoShapeType peut être une des constantes suivantes ---
        '-----------------------------------------------------------
 
            'Consultez aussi les constantes AutoShapeType pour identifier les différents
            'types de formes automatiques msoAutoShape.
        Case msoAutoShape: MsgBox "Forme automatique: " & Obj.Name
        'Case msoCallout
        Case msoChart: MsgBox "Graphique: " & Obj.Name
        Case msoComment: MsgBox "Commentaire: " & Obj.Name
        Case msoDiagram: MsgBox "Diagramme/Organigramme: " & Obj.Name
        Case msoEmbeddedOLEObject: MsgBox "Objet incorporé: " & Obj.Name
            'Nota :
            'Chaque bouton des filtres automatiques est considéré
            'comme un objet formulaire (zone de liste/DropDown).
        Case msoFormControl: MsgBox "Objet formulaire: " & Obj.Name
        Case msoFreeform: MsgBox "Forme libre: " & Obj.Name
        Case msoGroup: MsgBox "Groupe: " & Obj.Name
        Case msoLine: MsgBox "Ligne: " & Obj.Name
        Case msoLinkedOLEObject: MsgBox "Objet incorporé lié au fichier: " & Obj.Name
        Case msoOLEControlObject: MsgBox "Objet de la boîte à outils Contrôle: " & Obj.Name
        Case msoPicture: MsgBox "Image: " & Obj.Name
            'msoShapeTypeMixed permet de vérifier si une plage de formes contient
            'des types d'objets différents :
            'Par exemple: If Selection.ShapeRange.Type = msoShapeTypeMixed Then
        'Case msoShapeTypeMixed: MsgBox "Combinaison de formes"
        Case msoTextBox: MsgBox "Zone de texte: " & Obj.Name
        Case msoTextEffect: MsgBox "WordArt: " & Obj.Name
    End Select
Next Obj

Dim Sh As Shape
 
For Each Sh In ActiveSheet.Shapes
    Sh.Delete
Next

Do Until ActiveSheet.Shapes.Count = 0
ActiveSheet.Shapes(1).Delete
Loop

ActiveSheet.Shapes.SelectAll
Selection.Delete

Sub GroupementShapes_Conditionnel()
    Dim Sh As Shape
    Dim Tableau() As String
    Dim i As Integer
 
    'Boucle sur les formes de la feuille active
    For Each Sh In ActiveSheet.Shapes
        'Vérifie si le nom de la forme commence par "Mvt".
        If Left(Sh.Name, 3) = "Mvt" Then
            i = i + 1
            'Redéfinit la taille du tableau et intègre le nom de la forme.
            ReDim Preserve Tableau(1 To i)
            Tableau(i) = Sh.Name
        End If
    Next
 
    'On sort si le tableau est vide.
    If i = 0 Then Exit Sub
 
    'Regroupe les formes dont le nom se trouve dans le tableau
    Set Sh = ActiveSheet.Shapes.Range(Tableau).Group
    'Renomme le groupe.
    Sh.Name = "NomGroupe"
End Sub

Sub InsertionImage_DansShape()
    Dim strImage As String
    Dim Sh As Shape
 
    'Représente la premiere forme de la Feuil1
    Set Sh = Feuil1.Shapes(1)
 
    strImage = "C:\Documents and Settings\mimi\dossier\fourmiz.JPG"
    Sh.Fill.UserPicture strImage
End Sub

Option Explicit
 
Private Const Fichier As String = "C:\ImageTemp.gif"
 
Private Sub CommandButton1_Click()
   Dim nb As Byte
   Dim Sh As Shape
 
   'Supprime l'image temportaire si elle existe
   If Dir(Fichier) <> "" Then Kill Fichier
 
    'Définit le 1er shape de la feuille comme image
    ' à afficher dans l'UserForm
    Set Sh = Worksheets("Feuil1").Shapes(1)
 
    'copie le shape dans la feuille
    Sh.CopyPicture
    'crée un graphique
    With ActiveSheet.ChartObjects.Add(0, 0, _
                        Sh.Width, Sh.Height).Chart
        .Paste 'colle l'image dans graphique
        ' enregistre le graphique au format gif
        .Export Fichier, "GIF"
    End With
 
    nb = ActiveSheet.ChartObjects.Count
    'supprime le graphique
    ActiveSheet.ChartObjects(nb).Delete
 
    'Affiche l'image dans le graphique
    Image1.Picture = LoadPicture(Fichier)
End Sub
 
 
 
Private Sub UserForm_Terminate()
   'Supprime l'image temportaire si elle existe
   If Dir(Fichier) <> "" Then Kill Fichier
End Sub

.OnAction NomMacro "Argument1","Argument2"'

Sub CreationShape()
    With Worksheets("Feuil1").Shapes.AddShape(msoShapeRectangle, _
            ActiveCell.Left, _
            ActiveCell.Top, _
            ActiveCell.Width, _
            ActiveCell.Height)
        .OnAction = "'InformationsShape " & Chr(34) & Date & Chr(34) & _
            "," & Chr(34) & Time & Chr(34) & "'"
    End With
End Sub

Sub InformationsShape(VarDate As String, VarTime As String)
    MsgBox "Forme '" & Application.Caller & "' créée le : " & _
        vbCrLf & VarDate & " " & VarTime
End Sub