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 :
Merci d'avance pour votre aide !
Cordialement
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 :
VB:
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