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 |
