Lopende tekst loopt niet

[hellboy01]

[Beste Helpmij-ers,

Ik wou een lopende tekst in mijn projectje aanbrengen en nu heb ik wat bruikbare code op jullie site gevonden alleen als ik die in mijn code plakt met wat aanpassingen doet die niets. Hebben jullie wat tips waar het op fout gaat?

alvast bedankt rob

'    Label1.Caption = "This is a test of a scrolling label with I hope a lot of text that will be bigger than the frame it is encapsulated within" ' for testing make this text larger than the width of the label
   ' Label1.Caption = CStr(TextBox1.Text)
    
    With Label1
        .Caption = "Welkom bij Rob's IJsco Winkeltje "
        .Font.Bold = True
        .Font.Size = 25
        .Font.Name = "tahoma"
        .ForeColor = vbRed
        .TextAlign = fmTextAlignCenter
    End With
    
    Label1.Left = frmIJswinkel.Width 'Frame1.Width ' start the text from the right end of the frame
    ' you can change this to start the text anywhere within the frame.
'    If CommandButton1.Caption = "Start Scroll" Then
'        CommandButton1.Caption = "End Scroll"
        Do
            Sleep 20
            Label1.Left = Label1.Left - 1 ' scroll the text left one pixel
            If Label1.Left <= -Label1.Width Then 'check for the text disappearing
                Label1.Left = frmIJswinkel.Width ' start the text at the right side of the frame
            End If
            DoEvents ' update
        Loop
    
        'End
   ' End If

http://www.helpmij.nl/forum/showthread.php/688173-Bewegende-tekst-in-textbox!

 

[OctaFish]

De code in het voorbeeld werkt prima, dus daar ligt het niet aan. Als het niet werkt in jouw bestand, dan hebben we meer aan het bestand (met de macro uiteraard) dan aan de code.

 

[hellboy01]

Bekijk bijlage IceCreamShop AutoOpen.xlsm

Nu is het probleem wat groter geworden want ik kan er niet meer in . dat stukje code had ik in de frm initialize gezet maar dat had ik beter niet kunnen doen denk ik.

 

[gast0660]

Hoi Rob,
Ik had hem echter nog liggen
Mijn vermoeden is dat bovenstaande code niet werkt omdat je label niet in een frame staat
Maar voldoet dit?

Groet
PS als ik bij u twee bolletjes wil bestellen eentje met vanille en eentje met aarbei heb ik wel een probleem

 

[gast0660]

Hoi Rob,
Omdat ik in een goeie bui ben
Met bovenstaande code
Groet

 

[hellboy01]

Hi gast0660, bedankt.
Ik kon er weer in na wat gegoogle, ik vermoedde al dat mijn do loop infinite was geworden en het bleek heel simpel met een ESC kon ik er weer in. weer een leer momentje ;-).
Maar buiten het frame werkt het ook met mijn test sub die van jullie gecopieerd had, zie link. Als ik de einden van het userform nam als keerpunt werkte die ook, dit met een knop als trigger.
Daarna heb ik de procedure in de initialize gezet en daar ging het fout. Ik had met f8 de flow doorlopen maar ik zag dat hij bleef hangen in de do loop procedure en omdat dat in initialize stond kwam hij initialize niet meer uit.
Ik zie dat je een button gebruikt om de looptekst te starten , maar ik wil eigenlijk dat hij na het opstarten van het formulier zelf begint te lopen. Heb je daar een idee voor?

groetjes robbeke

 

[hellboy01]

Bekijk bijlage IceCreamShop AutoOpen.xlsm

hier werkt die ook maar met een knop om te starten

 

[gast0660]

Hoi Rob,
Zet je code onder PrivateSub Userform_Activate()
Zie vb code

Private Sub UserForm_Activate()
 With Label1
        .Caption = "Welkom bij Rob's IJsco Winkeltje "
        .Font.Bold = True
        .Font.Size = 25
        .Font.Name = "tahoma"
        .ForeColor = vbRed
        .TextAlign = fmTextAlignCenter
    End With
    
    Label1.Left = frmIJswinkel.Width 'Frame1.Width ' start the text from the right end of the frame
'    ' you can change this to start the text anywhere within the frame.
''    If CommandButton1.Caption = "Start Scroll" Then
''        CommandButton1.Caption = "End Scroll"
       Do
            Sleep 20
            Label1.Left = Label1.Left - 1 ' scroll the text left one pixel
            If Label1.Left <= -Label1.Width Then 'check for the text disappearing
                Label1.Left = frmIJswinkel.Width ' start the text at the right side of the frame
            End If
            DoEvents ' update
        Loop
'
        'End
End Sub

Groet

 

[hellboy01]

Hi gast0660, werkt helemaal, bedankt :thumb:

Weet jij misschien of ik de tekst ook in het midden kan laten beginnen, want nu begint hij helemaal rechts.

groetjes rob

 

[hellboy01]

@dotchejack, ik ga eens nadenken over het kunnen bestellen van 1 bolletje vanilla en 1 bolletje aarbei

 

[gast0660]

Hoi,

Weet jij misschien of ik de tekst ook in het midden kan laten beginnen, want nu begint hij helemaal rechts.

Ja dat kan wel
Verander de code naar

Private Sub UserForm_Activate()
With Label1
        .Caption = "Welkom bij Rob's IJsco Winkeltje "
        .Font.Bold = True
        .Font.Size = 25
        .Font.Name = "tahoma"
        .ForeColor = vbRed
        .TextAlign = fmTextAlignCenter
    End With
    
    Label1.[COLOR="#FF0000"]Left = frmIJswinkel.Width - 213[/COLOR] 'Frame1.Width ' start the text from the right end of the frame
'    ' you can change this to start the text anywhere within the frame.
''    If CommandButton1.Caption = "Start Scroll" Then
''        CommandButton1.Caption = "End Scroll"
       Do
            Sleep 20
            Label1.Left = Label1.Left - 1 ' scroll the text left one pixel
            If Label1.Left <= -Label1.Width Then 'check for the text disappearing
                Label1.Left = [COLOR="#FF0000"]frmIJswinkel.Width - 213[/COLOR] ' start the text at the right side of the frame
            End If
            DoEvents ' update
        Loop
'
        'End
End Sub

Als je je afvraagt waar die 213 vandaan komt, uw label is 426, in het midden starten is dus de helft
Nog een tip voor de optionbuttons, mischien oliebollen verkopen, 7 stuks of 14 stuks of 21 stuks,ben je direct klaar
Edit: ik ben fout, 213 aanpassen naar de helft van uw userform is (251.25) punt, geen komma

 

[hellboy01]

Hi gast0660, nog een vraagje waar ik niet uitkom. Ik merk dat als ik via sub exit

Private Sub btnExit_Click()
Application.Visible = True
Unload Me
End Sub

het formulier afsluit de loop

 Do
            Sleep 20
            Label1.Left = Label1.Left - 1 ' scroll the text left one pixel
            If Label1.Left <= -Label1.Width Then  'check for the text disappearing
                Label1.Left = frmIJswinkel.Width ' start the text at the right side of the frame
            End If
            DoEvents ' update
        Loop

blijft doorlopen. Ik moet via het VBE de makro handmatig stoppen.

Hoe kan ik als ik de sub exit gebruik een END loop triggeren?
Het origineel wekt met een knop maar ik weet niet wat voor trigger het afsluiten van form activate is.

De volgende versie wordt met knoppen per item. Ik heb wat promofilmpjes op YT bekeken van kassasystemen , bijvoorbeeld elke keer dat je op vanilla drukt komt er 1x bij de variabele aantalVanille etc, ik ben er nog op aan het broeden

groetjes rob