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 = "https://www.developpez.com/template/logo.gif"
    Set Shp = Feuil1.Shapes.AddPicture(Fichier, msoFalse, msoCTrue, 0, 0, 150, 70)
End Sub

Dim strImage As String
Dim Sh As Shape
 
Set Sh = Worksheets("Feuil1").Shapes.AddShape(msoShapeRectangle, 40, 80, 140, 50)
 
strImage = "https://www.developpez.com/template/logo.gif"
Sh.Fill.UserPicture strImage

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