Sub InsertionImage()
    Dim Emplacement As Range
    Dim Img As Object
    Dim ShapeObj As Shape
    
    'Boucle pour supprimer l'ancienne image
    For Each ShapeObj In ActiveSheet.Shapes
        If ShapeObj.Name = "Cible" Then ActiveSheet.Shapes("Cible").Delete
    Next ShapeObj
    
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        'Définit l'emplacement de l'image
        Set Emplacement = Range("D3:E8")
        
        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
        
        With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
            .Name = "Cible"
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With
    
    Else
        MsgBox "Insertion d'image interrompue."
    End If
    
End Sub

Sub AjoutImageFeuille_V01()
    Dim Fichier As String
    
    Fichier = "C:\Documents and Settings\mimi\dossier\ Image2.jpg"
    Feuil1.Pictures.Insert Fichier
End Sub

Sub AjoutImageFeuille_V02()
    Dim Shp As Shape
    Dim Fichier As String
    
    Fichier = "C:\Documents and Settings\mimi\dossier\Image2.jpg"
    'expression.AddPicture(FileName, LinkToFile, SaveWithDocument, Left, Top, Width, Height)
    Set Shp = Feuil1.Shapes.AddPicture(Fichier, msoFalse, msoCTrue, 0, 0, 100, 90)
End Sub

Sub AjoutImageFeuille_V03()
    Dim Shp As Shape
    Dim Fichier As String
    
    Fichier = "http://www.developpez.com/template/logo.gif"
    Set Shp = Feuil1.Shapes.AddPicture(Fichier, msoFalse, msoCTrue, 0, 0, 150, 70)
End Sub

Sub ExtractionImagesFeuille()
    Dim Pict As Picture
    Dim Nb As Byte
    
    Application.ScreenUpdating = False
    
    For Each Pict In Worksheets("Feuil1").Pictures
        Pict.CopyPicture 'copie l'image
        
        With Worksheets("Feuil1").ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
            .Paste 'colle l'image dans un graphique temporaire
            'Sauvegarde au format image, dans le même répertoire que ce classeur.
            .Export ThisWorkbook.Path & "\" & Pict.Name & ".gif", "GIF"
        End With
        
        'Supprime le graphique
        Nb = Worksheets("Feuil1").ChartObjects.Count
        Worksheets("Feuil1").ChartObjects(Nb).Delete
    Next Pict
    
    Application.ScreenUpdating = True
End Sub

Sub ImagePlageCellules()
    'La plage de cellules A1:B5 est copiée dans le Presse-papiers en tant qu'image.
    Worksheets("Feuil1").Range("A1:B5").CopyPicture
    'L'image est collée dans la feuille active
    Worksheets("Feuil1").Paste
    ' renomme l'image
    Selection.Name = "Image A1:B5"
End Sub

Sub exporter_Feuille_ImageJPG()
Dim Ligne As Integer, Colonne As Integer

Application.ScreenUpdating = False

'Copie, en tant qu'image, les cellules utilisées dans la feuille.
Feuil1.UsedRange.CopyPicture
Feuil1.Paste

'Récupére la position des dernières lignes et colonnes utilisées.
'Cette information va servir à redimensionner la taille de l'image.
Ligne = Feuil1.Cells.Find("*", Feuil1.Range("A1"), SearchDirection:=xlPrevious).Row + 1
Colonne = Feuil1.Cells.Find("*", Feuil1.Range("A1"), SearchDirection:=xlPrevious).Column + 1

'Crée un graphique temporaire
With Feuil1.ChartObjects.Add(0, 0, Cells(Ligne, Colonne).Left, Cells(Ligne, Colonne).Top).Chart
    .Paste
    'exporte l'image sur le disque dur, dans le même répertoire que ce classeur.
    .Export ThisWorkbook.Path & "\monImage.jpg", "JPG"
End With


With Feuil1
    'Supprime le graphique temporaire
    .ChartObjects(Feuil1.ChartObjects.Count).Delete
    'Supprime l'image dans la feuille.
    .Shapes(Feuil1.Shapes.Count).Delete
End With

Application.ScreenUpdating = True
End Sub

Sub SupprimerImagesFeuille()
    Dim Sh As Shape
    
    For Each Sh In Worksheets("Feuil1").Shapes
        If Sh.Type = msoPicture Then Sh.Delete
    Next
End Sub

=INDEX($C$2:$C$7;EQUIV(1;($A$2:$A$7>=F1-((F1*5)/100))*($A$2:$A$7<=F1+((F1*5)/100))*($B$2:$B$7>=F2-((F2*5)/100))*
($B$2:$B$7<=F2+((F2*5)/100));0))

Private Sub Graph_MouseMove(ByVal Button As Long, ByVal Shift As Long, _
                    ByVal x As Long, ByVal y As Long)
            
    Dim ElementID As Long
    Dim Arg1 As Long, Arg2 As Long

    
    On Error Resume Next
    ActiveChart.GetChartElement x, y, ElementID, Arg1, Arg2
            
    Range("A14") = x
    Range("A15") = y
End Sub

Sub DimensionsImage()
    'Fonctionne pour les formats:
        'JPG
        'jpeg
        'gif
        'bmp
    Dim iPict As IPictureDisp
    Dim NomFichier As String
    
    NomFichier = "C:\dossier\lapin.jpg"
    
    Set iPict = LoadPicture(NomFichier)
    MsgBox Round((iPict.Width) / 21.16, 0) & " x " & Round((iPict.Height) / 21.16, 0)

    Set iPict = Nothing
End Sub