Probleme sur l'import et exploitation des images sur Vba

Sub Vindediou()
Dim i As Byte, j As Integer, PosImage, Décal As Byte, OK As Boolean
Décal = 0
PosImage = Array("A1", "U1", "A12", "U12", "AF12", "U18", "AF18")
With Worksheets("Feuil1")
For i = 1 To 47 Step 23 ' pour chacun des 3 tableaux(ligne 1, 24 et 47)
    ActiveWindow.ScrollRow = 23 * Décal + 1
    For j = LBound(PosImage) To UBound(PosImage) ' pour chaque adresse de zone image
        .Range(PosImage(j)).Offset(Décal * 23, 0).Select
        For Each sh In .Shapes()
            If sh.Type = 13 Then
                If sh.TopLeftCell.Address(0, 0) = .Range(PosImage(j)).Offset(Décal * 23, 0).Address(0, 0) Then
                    OK = True
                    Exit For
                End If
            End If
        Next
        If Not OK Then
            Msg = "Voulez vous Insérer la Photo N°" & j + 1  ' Définit le message.
            Style = vbYesNo + vbDefaultButton2     ' Définit les boutons.
            Title = "Insertion Photo dans le tableau " & Décal + 1 ' Définit le titre.
            Rep = MsgBox(Msg, Style, Title)
            If Rep = vbYes Then    ' L'utilisateur a choisi Oui.
                Insert_Image .Range(PosImage(j)).Offset(Décal * 23, 0).Address(0, 0)
            End If
        End If
        OK = False
    Next
    Décal = Décal + 1
Next
End With
ActiveWindow.ScrollRow = 1
End Sub

Sub Insert_Image(Adresse)
Dim C As Range, Img 
Img = Application.GetOpenFilename("Images JPEG (*.jpg), *.jpg", , "Choisissez l'image ") ' choix nom du fichier
If Img <> False Then
    nom = Adresse
    With Worksheets("Feuil1")
     Set C = Range(Adresse).MergeArea ' pour gérer globalementles cellules fusionnées de la zone
     .Pictures.Insert(Img).Name = nom
     .Shapes(nom).Left = C.Left
     .Shapes(nom).Top = C.Top
     .Shapes(nom).LockAspectRatio = msoFalse
     .Shapes(nom).Height = C.Height
     .Shapes(nom).Width = C.Width
    End With
End If
End Sub

Sub Bouton1_Clic()

Msg = "Voulez vous insérer ls photos avec la macro"      ' Définit le message.
Style = vbYesNo + vbDefaultButton2          ' Définit les boutons.
Title = "Inserter les photos avec la macro "    ' Définit le titre.
rep = MsgBox(Msg, Style, Title)
If rep = vbNo Then Exit Sub   ' L'utilisateur a choisi non, on quitte.
                   
               


Dim i As Byte, j As Integer, PosImage, Décal As Byte, OK As Boolean
Décal = 0
PosImage = Array("W1", "AQ1", "W12", "AQ12", "BB12", "AQ18", "BB18")
With Worksheets("Feuil1")
.Activate

For i = 1 To 81 Step 40 ' pour chacun des 3 tableaux(ligne 1, 41 et 81)
   If .Cells(1 + 40 * Décal, 17) = "" Then Exit For
   If .Cells(1 + 40 * Décal, 17) <> "" Then
    ActiveWindow.ScrollRow = 40 * Décal + 1
        For j = LBound(PosImage) To UBound(PosImage) ' pour chaque adresse de zone image
            .Range(PosImage(j)).Offset(Décal * 40, 0).Select
            For Each sh In .Shapes()
                If sh.Type = 13 Then
                    nblignes = Range(PosImage(j)).MergeArea.Rows.Count - 1
                    If sh.TopLeftCell.Address(0, 0) = .Range(PosImage(j)).Offset(Décal * 40 + nblignes * (Décal > 0), 0).Address(0, 0) Then
                    OK = True
                        Exit For
                    End If
                End If
            Next
            If Not OK Then
                Msg = "Voulez vous Insérer la Photo N°" & j + 1  ' Définit le message.
                Style = vbYesNo + vbDefaultButton2     ' Définit les boutons.
                Title = "Fiche " & .Cells(1 + 40 * Décal, 17) ' Définit le titre.
                rep = MsgBox(Msg, Style, Title)
                If rep = vbYes Then    ' L'utilisateur a choisi Oui.
                    Insert_Image .Range(PosImage(j)).Offset(Décal * 40 + nblignes * (Décal > 0), 0).Address(0, 0)
                Else: rep = vbNo
                Exit For
                End If
            End If
            OK = False
        Next
        Décal = Décal + 1
   End If
Next
End With
ActiveWindow.ScrollRow = 1
End Sub