VBA, comment insérer des images dans des cellules fusionnées ave

Option Explicit
Dim cheminfichier As Variant
Dim position
Private Sub CommandButton1_Click()
open_file
detecteFusion
End Sub
Sub detecteFusion()
Dim cellule
 For Each cellule In Range("A1:M28") 'plage de recherche a adapter
 If Range(cellule.Address).MergeCells Then
 cellule.Select
 position = cellule.Address
 InsertImage
 End If
 Next cellule
 End Sub
Sub InsertImage()
If cheminfichier = "" Then Exit Sub
ActiveSheet.Pictures.Insert(cheminfichier).Select
With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Left = ActiveCell.Left
        .Top = ActiveCell.Top
        .Width = ActiveCell.Width * 2 'a adapter suivant les cellules fusionnées
        .Height = ActiveCell.Height
    End With
With Worksheets(1).Range(position)
   With .Borders(xlEdgeLeft)
        .LineStyle = xlDouble 'bordure double
        .Weight = xlMedium 'trait moyen
        .Color = RGB(255, 0, 0) 'rouge
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlDouble
        .Weight = xlMedium
        .Color = RGB(255, 0, 0)
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlDouble
        .Weight = xlMedium
        .Color = RGB(255, 0, 0)
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlMedium
        .Color = RGB(255, 0, 0)
    End With
   End With
End Sub
Sub open_file()
'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
   'Create a FileDialog object as a File Picker dialog.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
    With fd
'Add a filter that includes GIF and JPEG images and make it the first item in the list.
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
        .Title = "Choisissez une image"
        .InitialFileName = "C:\"
        .InitialView = msoFileDialogViewThumbnail 'afficher les miniatures

        'Use the Show method to display the File Picker dialog box and return the user's action.
        'If the user presses the action button...
        If .Show = -1 Then

            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
               cheminfichier = vrtSelectedItem
               Next
               End If
               End With
End Sub

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
position = Target.Address
End Sub

Option Explicit

Public position As String

Option Explicit
Private Sub CommandButton1_Click()
InsererImage
End Sub
Sub InsererImage()
Dim cellule
 Dim myPicture As String, MyRange As Range
 myPicture = Application.GetOpenFilename _
 ("Pictures (.bmp; .gif; .jpg; .png; .tif),.bmp; .gif; .jpg; .png; .tif", _
 , "Select Picture to Import")
Set MyRange = Selection
InsertAndSizePic MyRange, myPicture
 With Worksheets(1).Range(position)
   With .Borders(xlEdgeLeft)
        .LineStyle = xlDouble 'bordure double
        .Weight = xlMedium 'trait moyen
        .Color = RGB(255, 0, 0) 'rouge
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlDouble
        .Weight = xlMedium
        .Color = RGB(255, 0, 0)
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlDouble
        .Weight = xlMedium
        .Color = RGB(255, 0, 0)
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlMedium
        .Color = RGB(255, 0, 0)
    End With
   End With
End Sub
Sub InsertAndSizePic(Target As Range, PicPath As String)
Dim p As Picture
 Application.ScreenUpdating = False
On Error GoTo EndOfSubroutine:
 Set p = ActiveSheet.Pictures.Insert(PicPath)
If Target.Cells.Count = 1 Then Set Target = Target.MergeArea
With Target
        p.Left = .Left
        p.Top = .Top
        p.Width = .Width
    End With
EndOfSubroutine:
End Sub

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
position = Target.Address
End Sub

With Worksheets(1).Range(position)

 With ActiveSheet.Range(position)