Problema VBA e Macro: Riapertura in Loop del file a chiusura anticipata

[roberto2664Partecipante roberto2664]

Buongiorno
scrivo a voi per avere supporto su un rompicapo che non riesco a risolvere.
Avevo la necessità di creare un file utilizzato da più utenti in condivisione su Dropbox.
Il mio scopo era di creare un controllo che permettesse all'apertura di sapere se il file era o meno utilizzato in maniera da evitare le fastidiose "copie di conflitto" che giustamente dropbox crea se più utenti utilizzano il file in contemporanea.
Per questo ho utilizzato due macro: una per autosave e una per autoclose trascorso un certo periodo di tempo dall'apertura.
Le macro e il file funzionano.
Ho soltanto un problema: se il file viene chiuso in maniera prematura dall'utente prima che le macro terminino l'esecuzione il file si riapre in continuazione.
Ho provato a cercare sul web una soluzione a tutto ciò ma ciò che ho trovato non mi ha aiutato.
Questo benedetto file si riapre sempre.
Qui di seguito inoltro il codice da me utilizzato:

Codice in "ThisWorkbook"

Private Sub Workbook_Open()

If Sheets("Record").Range("K2") <> "" Then

MsgBox "Il file è già utilizzato da " & UserName & ". Ritorna più tardi"

ThisWorkbook.Close SaveChanges:=False

End If

Userform1.Show

DTime = Time

Application.OnTime DTime + TimeValue("00:00:05"), "SaveMe_MistakesandAll"

Application.OnTime DTime + TimeValue("00:20:00"), "CloseMe_MistakesandAll"

End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)

Run "Limpa"

Dim Current As Range

Set Current = Sheets("Record").Range("K2")

result = 0

Current.Value = UserName

result = 1

ThisWorkbook.Save

End Sub

Codice "Macro"

Sub Limpa()

    On Error Resume Next

    Application.OnTime DTime + TimeValue("00:02:30"), "SaveMe_MistakesandAll", , False

    Application.OnTime DTime + TimeValue("00:20:00"), "CloseMe_MistakesandAll", , False

    On Error GoTo 0

End Sub


Public DTime As Date


Sub SaveMe_MistakesandAll()

DTime = Time

Application.OnTime DTime + TimeValue("00:02:30"), "SaveMe_MistakesandAll"

ThisWorkbook.Save

End Sub


Sub CloseMe_MistakesandAll()

DTime = Time

Application.OnTime DTime + TimeValue("00:20:00"), "CloseMe_MistakesandAll"

Dim Current As Range

Set Current = Sheets("Record").Range("K2")

result = 0

Current.Value = UserName

result = 1

ThisWorkbook.Close SaveChanges:=True

End Sub

Il mio problema: interrompere l'esecuzione delle macro a chiusura anticipata. Potete aiutarmi?

Grazie mille

Saluti Roberto

[vecchio fracSenior Moderator vecchio frac Karma: 245 pts]

roberto2664 wrote:il file si riapre in continuazione.

Da solo?

Comunque non ho adesso il tempo di approfondire quello che sembra un quesito interessante, nè di fare dei test seri. Osservo solo che ti stai appoggiando a OnTime e non son sicuro che sia la scelta migliore (per un utilizzo così critico io penserei ad affidarmi alle API SetTimer e KillTimer che risultano indipendenti da Excel).

[roberto2664Partecipante roberto2664]

Si. Si riapre da solo.

Come si usano API SetTimer o KillTimer? Purtroppo non le conosco.

 

Grazie

 

Ciao

 

 

 

 

 

[Luca73Partecipante Luca73 Karma: 56 pts]

Ciao

non sono esperto di uso di On time.

Presuppongo che essendo legato ad application e non a workbook, rimane attivo anche a chiusura del workbook.

Io proverei nella procedure di "workbook_BeforeClose" a disabilitare tutti gli on time attivati. 

Leggendo l'help dovrebbe essere un qualcolsa del genere (copiato dall'help on line)

This example runs my_Procedure at 5 P.M.

Application.OnTime TimeValue("17:00:00"), "my_Procedure"

This example cancels the OnTime setting from the previous example.

Application.OnTime EarliestTime:=TimeValue("17:00:00"), _
Procedure:="my_Procedure", Schedule:=False

[Luca73Partecipante Luca73 Karma: 56 pts]

Suggerisco di leggere anche

https://answers.microsoft.com/it-it/msoffice/forum/msoffice_excel-mso_win10-mso_2010/application-ontime-curiosit%C3%A0/e193c4ce-0b21-4706-82ed-d59ed608512a

[roberto2664Partecipante roberto2664]

Ciao Luca73

grazie per la risposta. Ho già provato a fare ciò ma in "ThisWorkbook" mi da sempre un errore di runtime.

Ho quindi cercato di evitare il problema utilizzando in beforeclose la macro Limpa nella quale eseguo questo codice ma non funziona ugualmente.

[Luca73Partecipante Luca73 Karma: 56 pts]

Penso di aver capito il problema

leggendo 

http://www.snb-vba.eu/VBA_Application.OnTime_en.html

dice che:

per fermare 

Sub M_snb_ontime_start()
MsgBox "illustration"
Application.OnTime TimeSerial(12, 45, 0), "M_snb_ontime_start"
End Sub

If this macro has been executed it will execute itself over and over again as long as the application - Excel - hasn't been quit.
If you don't want that you will have to start a macro that will cancel the ontime method.
The only way to do so is to cancel the ontime method using the exact same macro name and time and setting the argument 'Schedule' to FALSE.
Stop the planned action before it's 12.45 o'clock
Sub M_snb_ontime_cancel()
Application.OnTime TimeSerial(12, 45, 0), "M_snb_ontime_start", , False
End Sub
In this case it's simple because it's a fixed time value.

It's less simple in the case of a variable time value, e.g. dateadd("s",10,time).
In such a case you will have to register the time value to be able to execute the 'cancel' macro.

You can register the time value in 2 ways:
- use a variable to store the time value
that variable has to be available/accessible in both macros (the start macro and the cancel macro) 
- use a property of the application (Excel), of a workbook or a worksheet or one of the objects in the application, a workbook or a worksheet

[vecchio fracSenior Moderator vecchio frac Karma: 245 pts]

'rendi disponibile la funzione
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

'uccidi il timer
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

'inserisci qui il codice da eseguire
Public Sub TimerRoutine(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long)
.
.
.
End sub

'per attivare il timer ogni 500 millisecondi
timerID = SetTimer(0, 0, 500, AddressOf Timer_Routine)

'per disattivare il timer
KillTimer 0, timerID

Questo per completare l'info. Poi magari vediamo come funziona 🙂

[Autore]

Articoli