ora in userform con testo scorrevole

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ciao,

nel workbook allegato all'avvio compare un'userform con testo scorrevole.

In questo testo scorrevole c'è una data e un'ora che non si aggiorna, i secondi restano fermi.

Come si può correggere?

Grazie

Allegati:

You must be logged in to view attached files.

[alexps81Moderatore alexps81 Karma: 58 pts]

Ciao prova così:

in ThisWorkbook:

Option Explicit

Private Sub Workbook_Open()
    UserForm1.Show
 End Sub

in UserFrom1:

Option Explicit

Dim Pos As Long
Dim FineScorrimento As Single

Private Sub UserForm_Initialize()
    Pos = 1
End Sub

Private Sub UserForm_Activate()
    'quando la form si attiva, si imposta un timer di fine scorrimento _
    che dura dal momento dell'attivazioene della form + 6,5 secondi
    FineScorrimento = Timer + 6.5
    'richiama la sub Scorri
    Scorri
End Sub

Private Sub Scorri()
    Dim Testo As String
    Dim t As Single

    'esegue un ciclo fin quando il tempo attuale è inferiore a quelle di FineScorrimento -->(tempo iniziale + 6,5 secondi)
    Do While Timer < FineScorrimento And Me.Visible
        'definisce il Testo da mostrare
        Testo = "oggi è " & Format(Now, "dddd dd - mmmm - yyyy") & _
                " ore " & Format(Time, "hh:mm:ss") & " buon lavoro.   "
        
        'mostra il testo nella Caption di Label1 _
        esattamente all'inizio del cilo mostra solo i primi 38 caratteri del Testo
        Me.Label1.Caption = Mid$(Testo, Pos, 38)
        
        'prepara il prossimo Testo da visualizzare, spostando la posizione di partenza _
        di un posto più...quindi al secondo ciclo la posizione di partenza sarà "ggi è...." _
        al terzo ciclo la posizione sarà "gi è..." e così via...
        Pos = Pos + 1
        If Pos > Len(Testo) Then Pos = 1
        
        'inizializza un tempo di attesa per consentire la visualizzazione dello scorrimento del testo
        t = Timer + 0.1
        Do While Timer < t
            DoEvents
            If Not Me.Visible Then Exit Sub
        Loop
    Loop
    Unload Me
End Sub

Rimuovi quello che hai scritto in Modulo1 perché non serve.

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

La variabile "testo" è fuori dal ciclo e, pertanto, non viene aggiornata. Aggiungi qualcosa, dentro il ciclo, per aggiornarla. Attento a chiudere il tempo .

Ciao,

Mario

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Grazie alexps81.

Se clicco nella X dell'userform và in debug qui

If Not Me.Visible Then Exit Sub

 

 

Allegati:

You must be logged in to view attached files.

[LukeRedsPartecipante LukeReds Karma: 19 pts]

ciao,

potresti cavartela con .. ..aggiungendo una label "fine" prima della end sub

Do While Timer < t
  DoEvents
  On Error GoTo fine
Loop

[alexps81Moderatore alexps81 Karma: 58 pts]

Ciao @franck_ciccio o segui il suggerimento di Luke  oppure potresti direttamente impedire la chiusura della UserForm dalla X con:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Grazie alexps81 e lukereds

[Autore]

Articoli