Bouton next Boucle For

Bonjour,

Voici mon problème :

j'ai un userform qui fonctionne sur une boucle for, j'aimerais ajouter un bouton qui tant que l'on appuie pas dessus on ne passe pas a la boucle suivant ( variable augmente de 1 ).

Voici le code :

Private Sub UserForm_Activate()
Dim sh As Worksheet
Dim Chemin As String
Dim Plage As String

'****************** À définir********************
'Chemin = ThisWorkbook.Path & "\"
Chemin = "C:\Users\person\Pictures\"
Fichier = "ImagePlageCellule"
Plage = "A2:A10"
Set sh = Worksheets("Feuil1") 'Nom Feuille à adapter
'*************************************************
Dim Img As Shape
Dim Imgmesu As Shape
Dim strPic As String
Dim strPic2 As String

With Me.Image1
    .Picture = LoadPicture(("C:\Users\person\Pictures\ImagePlageCellule.gif"))
    .PictureSizeMode = fmPictureSizeModeStretch
    .PictureTiling = False
End With

Sheets("Feuil1").Activate
col = Range([A2], [A2].End(xlToRight)).Columns.Count

Sheets("Feuil6").Activate
    For d = 2 To col Step 1
        If Not Sheets("Feuil1").Cells(11, d) = "Vu" Then
            ref = Sheets("Feuil1").Cells(2, d).Value
            ladate = Sheets("Feuil1").Cells(4, d).Value
        Set r = Sheets("Feuil6").Columns(2).Find(ref, LookIn:=xlValues, lookat:=xlWhole)
            If Not r Is Nothing Then
            Sheets("Feuil6").Activate
        'Set Plage = Range(Cells(r.Row + 2, 2), Cells(r.Row + 7, 2))
            With Sheets("Feuil6")
                .Range(Cells(r.Row + 1, 2), Cells(r.Row + 9, 2)).CopyPicture xlScreen, xlBitmap
                .Paste Destination:=.Range("A12")

         Set Img = Sheets("Feuil6").Shapes(Selection.Name)
         With .ChartObjects.Add(0, 0, Img.Width, Img.Height).Chart
        .Parent.Select
        .Paste
        .Export ref & "_" & ladate & ".gif", "GIF"
         End With
    .ChartObjects(1).Delete
    Img.Delete
    strPic = "C:\Users\person\Documents\" & ref & "_" & ladate & ".gif"
  End With

  Sheets("Feuil1").Activate
    With Sheets("Feuil1")
                .Range(Cells(2, d), Cells(10, d)).CopyPicture xlScreen, xlBitmap
                .Paste Destination:=.Range("A12")

       Set Imgmesu = Sheets("Feuil1").Shapes(Selection.Name)

    With .ChartObjects.Add(0, 0, Imgmesu.Width, Imgmesu.Height).Chart
        .Parent.Select
        .Paste
        .Export "Mesu" & "_" & ref & "_" & ladate & ".gif", "GIF"
         End With
    .ChartObjects(1).Delete
    Imgmesu.Delete
    strPic2 = "C:\Users\person\Documents\" & "Mesu" & "_" & ref & "_" & ladate & ".gif"

End With

End If

End If

With Me.Image2
    .Picture = LoadPicture(strPic)
    '.PictureSizeMode = fmPictureSizeModeZoom
    .PictureSizeMode = fmPictureSizeModeStretch
    .PictureTiling = False
 End With

    With Me.Image3
    .Picture = LoadPicture(strPic2)
    '.PictureSizeMode = fmPictureSizeModeZoom
    .PictureSizeMode = fmPictureSizeModeStretch
    .PictureTiling = False

End With

'Je pense que le code necessaire devrait venir ici, mais je n'arrive pas à l'écrire.

Next

End Sub

Merci d'avance pour votre aide !

Cordialement

tu devrais joindre ton fichier