Do Loop onderbreken met een key

[DutchOirs]

Goedenavond allen,

Zit met een vraagje:

Hoe kan je een Do - Loop onderbreken? Dit met bv. de esc key

Heb een vb-tje bijgevoegd

Thanks already

Dutch

 

[HSV]

Kijk eerst eens naar de code.

Notitienummer = 6

Wat zal die 2 opleveren in onderstaand stukje?

If NotitieNummer = Mid(fName, 4, 2) Then

 

[DutchOirs]

Goedenavond HSV,

Die code levert het juiste Notitie Nummer op:

  If NotitieNummer = Mid(fName, 4, 2) Then

levert in de kleine getallen (1-9) het juiste nummer op.
en levert bij de grote getallen (10-99) het juiste nummer op.

Heb 2 genomen omdat je na 9 2 getallen krijgt.

Het werkt perfect in m'n file.

 

[HSV]

Goedenavond DutchOirs

Dan zal het 4e cijfer een 0 (nul) zijn.
Dan is het resultaat van mid(fname,4,2) dus 06 en gelijk aan 6 in dit geval.

Niet dat ik een oplossing weet om uit die loop te springen met een toets (ik gebruik Esc, maar dat bewijst niet of ik al in die loop zit).

Wat is het doel als ik vragen mag?

 

[DutchOirs]

Hoi HSV,

Het gehele naam v/d notitie is:

Not (betekent Notitie) & Notitienummer (1 of 2 getallen) & spatie & Datum v/d foto & _ & getal

vb. Not1..20201030_1

als ik meerdere foto's maak voor Notitie 1 op 2020-10-30 en op 20201031 wordt dan

Not1..20201030_1
Not1..20201030_2
Not1..20201030_3
Not1..20201031_1
Not1..20201031_2
Not1..20201031_3
enz.

Bij Notitie 11 wordt dit dan:
Not11.20201030_1
Not11.20201030_2
Not11.20201030_3
Not11.20201031_1
Not11.20201031_2
Not11.20201031_3
enz.

Het doel is om bij een slide van foto's van een Notitie, te kunnen stoppen dus uit die lus komen.
Als er veel foto's zijn duurt het te lang als men wilt stoppen met de slide

 

[VenA]

Wat bij mij meestal werkt om uit een lus te komen is <Ctrl> + <Break> of toetenbordafhankelijk <Ctrl> + <Pauze>

 

[DutchOirs]

Goedemiddag VenA,

Dat werkt inderdaad hier ook.
Maar is geen nette manier op uit die lus te komen. Je onderbreekt het hele progg.

Ben nu bezig via een zijweg om toch op een nette manier eruit te komen.

 

[snb]

Iedere lus in code moet in de code zelf beëindigd worden.
Als je daarvoor een gebruikersinterventie nodig hebt, heb je de code niet juist geprogrammeerd.

 

[DutchOirs]

Goedemiddag snb,

Ben het met je eens, dat je in dezelfde lus moet eindigen.

Heb er iets op gevonden via een omweg.

Heb van alles geprobeerd maar kwam hierop uit.

Heb in die lus een variabele (Uit) gezet.

Als je tijdens de loop v/d lus op Uitknop drukt wordt de variabele (Uit) 1

En het werkt

Enigste nadeel wat ik tegenkom is dat het 1 a 2 sec. duurt voor hij stopt.

Private Sub SlideStartBut_Click()
  AantalTellen
  SlideStopBut.Visible = 1
  Dim i As Integer, x As Integer, fList As String, fName As String, fPath As String, NotitieNummer As Integer, SlideAantal As Integer
  NotitieNummer = 6
  fPath = ActiveWorkbook.Worksheets("Blad1").Range("D5")
  fName = Dir(ActiveWorkbook.Worksheets("Blad1").Range("D5") & "*.jpg")     ' https://www.excelfunctions.net/vba-dir-function.html
  SlideAantal = 0
  Uit = 0
  SlideTotTB = "/ " & TotAantal
  
  Do While fName <> ""
    With Application.FileDialog(1)
      If NotitieNummer = Mid(fName, 4, 2) Then
        For x = 1 To 25
          If Mid(fName, 18, 1) = x Then
            NotitiesImage.Tag = fPath & fName
            NotitiesImage.Picture = LoadPicture(fPath & fName)
            NaamImage = fPath & fName                                     ' geeft de TextBox het Path en de naam van het File
            SlideAantal = SlideAantal + 1
            AantalTB = SlideAantal
            DoEvents
            If Uit = 1 Then
              NotitiesImage.Picture = LoadPicture(fPath & ActiveWorkbook.Worksheets("Blad1").Range("D7"))
              fName = Dir()
              AantalTB = ""
              GoTo Uit
            End If
            Application.Wait DateAdd("s", 2, Now)
          End If
        Next x
      End If
    End With
    fName = Dir() ' Get the next .csv file within "C:\DataFiles\".
  Loop
  NotitiesImage.Picture = LoadPicture(fPath & ActiveWorkbook.Worksheets("Blad1").Range("D7"))
Uit:
End Sub

Maar kan er mee leven

 

[DutchOirs]

Update van voorbeeld bestandje uit:



https://www.helpmij.nl/forum/showthread.php/956419-In-een-UserForm-Image-een-picture-invoeren

 

[pixcel]

Goed dat je dit gevonden hebt (#9). Dit is inderdaad de manier om dit te doen. Je gebruikt er nu een knop voor en het Click event. Maar het Userform heeft ook een KeyPress event, hiermee kun je controleren of Esc is ingedrukt.

Dat het 1 a 2 seconden duurt komt doordat je loop de meeste tijd in de Wait stand staat. Pas als die Wait voorbij is gaat de loop weer verder, en pas bij DoEvents zal je click event verwerkt worden. Het beste gebruik je geen Wait of loze wacht loopjes maar een timer (Application.OnTime).

 

[DutchOirs]

Goedemorgen pixcel,

Als je de esc knop gebruikt gaat ie 1 verder, maar niet de lus uit :-(

Jammer maar werkt dus niet.

Ben nu bezig om een pauze toets te maken. Als je die indrukt dat ie stopt op dat moment en als je weer drukt zou ie verder moeten gaan.
Komt wel voor dat je een bepaalde foto langer wilt zien.

Vr. Gr.

Dutch

 

[DutchOirs]

Goedemorgen,

Laatste Update voor de Loop event.

Om foto's die bij een bepaalde Notitie behoren het volgende gedaan en bereikt:

- In dit voorbeeld is het NotitieNummer al gegeven;
- In desbetreffende (foto) Map staan alle Foto's bij elkaar van alle Notities;
- a.d.h.v. NotitieNummer worden alleen de NotitieNummer foto's getoond;
- Als men de Slide start, loopt deze (met 2 sec. verschil) door de Loop heen.
- Men kan de Slide pauzeren en blijft dan op desbetreffende foto staan
- Bij Slide Restart begint de Slide overnieuw;
- Bij Slide stoppen, stopt de Slide show;

Het geheel werkt redelijk en enigste min puntje is dat (door het wait event) het af en toe schokkerig gaat.

  Do While fName <> ""
    With Application.FileDialog(1)
      If NotitieNummer = Mid(fName, 4, 2) Then
        For x = 1 To 25
          If Mid(fName, 18, 2) = x Then
            If Uit = 0 Then
              NotitiesImage.Tag = fPath & fName
              NotitiesImage.Picture = LoadPicture(fPath & fName)
              NaamImage = fPath & fName                                     ' geeft de TextBox het Path en de naam van het File
              SlideAantal = SlideAantal + 1
              AantalTB = SlideAantal
            End If
            DoEvents
            If Uit = 1 Then                             ' Exit Slide
              fName = Dir()
              AantalTB = ""
              Exit Do
            End If
            If SlidePauzeOptBut = True Then Vlag = False
            If Vlag = False And OpstartVlag = 0 Then    ' Pauze Slide
              NotitiesImage.Picture = LoadPicture(TmpNotitiesImage)
              NaamImage = TmpNotitiesImage                                  ' geeft de TextBox het Path en de naam van het File
              Exit Do
            End If
            If Vlag = True Then Application.Wait DateAdd("s", Sec, Now)
            TmpNotitiesImage = fPath & fName
          End If
        Next x
      End If
    End With
    If OpstartVlag = 0 Then fName = Dir() ' Get the next .csv file within "C:\DataFiles\".
  Loop

Voorbeeldje erbij.

Succes allen.

Dutch

 

[snb]

Is dit in plaats van een powerpointpresentatie ?

 

[DutchOirs]

Goedemiddag snb,

Zo zou je het kunnen zien, maar waarom PowerPoint starten als je al in Excel zit en bezig bent.

Alhier kan ik het e.e.a. nog sturen met VBA.

 

[snb]

Waarom VBA gebruiken voor een Powerpointtaak.

 

[DutchOirs]

Omdat men het NotitieNummer makkelijker kan doorgeven en in dit geval een Slide automatisch kan laten uitvoeren.

 

[DutchOirs]

Nog even ter aanvulling het voorbeeld bestandje van UserForm-Image.

Hierin diverse voorbeeldjes om pictures te behandelen/verwerken met VBA in Excel.

Succes allemaal.

 

[pixcel]

In bijlage een demo die in essentie hetzelfde doet als jouw app, maar deze is zonder do-loop. En dus ook geen Wait en DoEvents.
Verder zijn Esc en P beide toggles voor pauzeren en doorgaan.
Misschien kun je er wat mee.

 

[DutchOirs]

Goedemorgen Pixcel,

Ga ik uitpluizen

Gebruik alleen Excel 2003, dus enige dingen nog aanpassen.

Thanks