Userform con animazione e testo scorrevole

Saluti a tutti.
Ho già postato la question su altri forum, ma non ho ricevuto risposta alcuna.
Ho creato una userfor che contiene un'animazione di una clessidra funzionante grazie all'aiuto esterno.
Ora volevo aggiungergi un testo scorrevole, entrambi funzionano in successione, ma vorrei sincronizzare la cosa in modo che mentre si muove la clessidra scorre il testo.
Ci sono anche alcune problematiche nel codice in quanto in realtà la form alla chiusura non è realmente chiusa pur utilizzando .hide.
Scopo del tutto, è di creare un modo accattivante per il tempo di attesa per l'apertura di un proggrammino.
Quindi da inserire nell'evento Thisworkbooks open logicamente con impostazioni macro sempre attivate. Spero di essermi spiegato
Questi sono i codici

Codice:
Option Explicit
Private muovi As Boolean
'Disabilitazione chiusura form nascondendo X
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long

Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long

Codice:

Private Sub UserForm_Initialize()
SetWindowLong FindWindow( _
vbNullString, Me.Caption), _
-16, -2067791744
End Sub

Codice:

Private Sub UserForm_Activate()
Dim Ora As Single
Dim Testo As String
Dim Ripetizione As Long
Dim I As Long

'Testo Da scorrere
Testo = "     Attendere prego ......."

'Calcola la ripetizione del ciclo
Ripetizione = Len(Testo) + 1
For I = 2 To Ripetizione

    'attesa un secondo
    Ora = Timer + 0.4
    Do Until Ora <= Timer
    Loop
   
    'Lascia eseguire il codice
    DoEvents
   
    'il numero dopo la variabile I indica il numero dei caratteri visibili nella label
    Label1.Caption = Mid(Testo, I, 28)
Next I
'Animazione immagini
muovi = True
Call Animaz
End Sub

Codice:

Private Sub Animaz()
'Archi 06-06-2013

Dim x As Integer, y As Integer, MyTimer As Double, SavePath
DoEvents
x = 1
y = 1
MyTimer = Timer
SavePath = ThisWorkbook.Path
SavePath = SavePath & "\Animazione\Cles"
Do
    On Error Resume Next
    UserForm1.Image1.Picture = LoadPicture(SavePath & x & ".Bmp")
    On Error GoTo 0
    Do
    Loop While Timer - MyTimer < 0.15
        If x = 12 Then
            x = 1
            Else
            x = x + 1
        End If
        MyTimer = Timer
        DoEvents
    Loop While muovi
    muovi = False
End Sub

Codice:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 If CloseMode = 0 Then
        Cancel = True
        MsgBox "Non è possibile chiudere sino a completamento lavoro", vbCritical
    End If
'muovi = False
End Sub
Ciao a tutti
 

Informazioni domanda


Ultimo aggiornamento febbraio 27, 2018 Visualizzazioni 858 Si applica a:
Risposta
Io ti espongo la mia (mia eh!) idea.

Le cose semplici sono le migliori.

 

Vedi qui:

http://www.maurogsc.eu/esempiforum13/userformchiusura.zip

Utilizzo un ciclo for che simula quelle che possono essere le tue operazioni che necessitano di una attesa.

 

Il codice funziona su sistemi a 32/64 bit.

--
Mauro Gamberini
Microsoft© MVP (Excel)
http://www.maurogsc.eu

Il problema è stato risolto?

Siamo spiacenti che questo non sia stato d'aiuto.

Fantastico! Grazie per aver scelto questa risposta.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento, ci aiuta a migliorare il sito.

Sei soddisfatto di questa risposta?

Grazie per il tuo commento.