VBA slideshow-ish

[CsJHUN]

Hi guys

i would like to create a userform, which load pictures from a folder, and change the pictures every 3-4 seconds, while the user can select between 2 option button ( good or not good).
And the picture name,the selected option button value would be registered below each other.
The 'sleep' and 'wait' can not let user to choose between optionbuttons (basically not let you do anything, but... xD ) I stared ggle 30 minutes ago. the result is some "wastetime" macro (by Philip Trecay) but its looks like not working for me.

Parts of the userform macro is here, some parts has to be added later, but the issue now is the next-picture-auto-loading
So far i have this with comments for you:

Private Sub btn_start_Click()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim ofiles As Variant
Dim i As Integer
Dim item As Variant

btn_start.Visible = False                      'a start button to start process
lbl_bevezeto.Visible = False                 'pre-start notification with information for the users
opbtn_OK.Visible = True                       'one optionbutton
opbtn_NG.Visible = True                      'other optionbutton
img_test.Visible = True                         'the picture frame
lbl_timer.Visible = True                         'a visible timer. This could be good to have but not necessary.

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(kepk)
Set ofiles = oFolder.Files

For Each item In ofiles
kep = item.Path
img_test.Picture = LoadPicture("") 'added this becuase looked like its not change the pictures.
img_test.Picture = LoadPicture(kep)

'___________here I need your help, to automatically load the next picture



'___below this is just register the choice and picture name
i = i + 1
Range("B6").Offset(i, 0).Value = item.Name
Range("C6").Offset(i, 0).Value = which_optionbutton_selected             'not writed yet

Next item
End Sub

Any advice, guidelines are welcome.
Cheers J.

 

[CsJHUN]

yo guys,
managed to solve it with VBA.Timer, here is the full code:

Private Sub btn_start_Click()
If tb_nev.Value = "" Or tb_tsz.Value = "" Then
MsgBox ("Töltsd ki a nevet és a törzszámot!")
Exit Sub
End If

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim ofiles As Variant
Dim i As Integer
Dim pic_arr As Variant

btn_start.Visible = False
lbl_bevezeto.Visible = False
opbtn_OK.Visible = True
opbtn_NG.Visible = True
img_test.Visible = True
lbl_timer.Visible = True

Range("B1").Value = tb_nev.Value
Range("B2").Value = tb_tsz.Value
Range("B3").Value = Now

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(kepk)
Set ofiles = oFolder.Files


Dim item As Variant
For Each item In ofiles
    kep = item.Path
    img_test.Picture = LoadPicture("")
    img_test.Picture = LoadPicture(kep)
    
    Application.ScreenUpdating = True
    
    a = VBA.Timer
    Do
    B = VBA.Timer
    DoEvents
    Loop Until B >= a + idokoz
    
    
    If opbtn_OK.Value = False And opbtn_NG.Value = False Then valasz = "NV"
    If opbtn_OK.Value = True Then valasz = "OK"
    If opbtn_NG.Value = True Then valasz = "NG"
    
    
    i = i + 1
    Range("B6").Offset(i, 0).Value = item.Name
    Range("C6").Offset(i, 0).Value = valasz
    kepstatus = Mid(item.Name, Len(item.Name) - 5, 2)
    If kepstatus <> valasz Then
    Range("D6").Offset(i, 0).Value = "Rossz válasz"
    rv = rv + 1
    Else
    Range("D6").Offset(i, 0).Value = "Jó válasz"
    jv = jv + 1
    End If
    
    opbtn_NG.Value = False
    opbtn_OK.Value = False
    
Next item
Unload Me
Range("B4").Value = Now
ThisWorkbook.SaveAs ThisWorkbook.Path & "\tesztek\" & Environ("username") & Format(Now, "yyyymmdd hhnnss") & ThisWorkbook.Name
MsgBox ("Jó válasz: " & jv & vbCrLf & "Rossz válasz: " & rv)
ThisWorkbook.Close
End Sub

Optionally i will save the result to a results file where all previous test result will be.