Chiusura a tempo dei file.xls non attivi

[patel]

Buongiorno a tutti, vorrei riprendere quanto consigliato da Anthony, che saluto, in questa vecchia discussione viewtopic.php?t=88590 e precisamente la macro

Codice: Seleziona tutto

Public InFoc
Public Flag1
Private Declare Function GetActiveWindow Lib "user32" () As Long

Sub InFocusYN()
    If GetActiveWindow <> Application.Hwnd Then
        If InFoc = True Then InFoc = Now()
    Else
        InFoc = True
    End If
'If Flag1 = False Then ThisWorkbook.Close SaveChanges:=True 'oppure False
If InFoc <> True Then
    If InFoc + TimeValue("00:15:00") < Now Then
    ThisWorkbook.Close SaveChanges:=True 'oppure False
    End If
End If
If Flag1 <> True Then     '**Vedi descrizione
    If Flag1 + TimeValue("00:15:00") < Now Then
'    ThisWorkbook.Close SaveChanges:=True 'oppure False
    End If
End If
DeltaT = "00:01:00"
Application.OnTime Now + TimeValue(DeltaT), "InFocusYN"
End Sub
Private Sub Workbook_Activate()    ' Gestione Flag1, INVARIATA
Flag1 = True
End Sub

Private Sub Workbook_Deactivate()   'Gestione Flag1, VARIATA
Flag1 = Now()
End Sub

Private Sub Workbook_Open()   'AGGIUNTA per lanciare InFocYN la prima volta
Flag1=True
Call InFocusYN
End Sub

funziona perfettamente per lo scopo in oggetto, però c'è un problema, se l'utente salva e chiude il file manualmente prima dello scadere del tempo lasciando attivo excel , la macro continua a lavorare e RIAPRE il file.
2 domande:
1) si può ovviare a questo inconveniente ?
2) perché vengono usati 2 flag (flag1 e InFoc) non ne potrebbe bastare uno ?

[Anthony47]

Eh, e' che spesso si controlla che una macro fa quello che deve fare ma si dimentica di controllare che in tutte le situazioni in cui non dovrebbe operare effettivamente non opera...
Nel caso, il tutto si ripeteva ogni minuto con una Application.OnTime in coda al codice che hai ricordato.
Bisogna deschedulare la riesecuzione della macro alla chiusura del file; quindi aggiungo una variabile Public in cui memorizzo l'ora di attivazione e la uso alla chiusura del file.

Codice: Seleziona tutto

Public InFoc
Public Flag1
Public nextR        'AGGIUNTA
Private Declare Function GetActiveWindow Lib "user32" () As Long

Sub InFocusYN()
'
'codice
'codice
'codice
'
DeltaT = "00:01:00"
nextR = Now + TimeValue(DeltaT)         'AGGIUNTA
Application.OnTime nextR, "InFocusYN"   'MODIFICATA
End Sub


Va infine aggiunta una macro di Before_Close in ThisWorkbook, aggiuntiva a quanto gia' descritto nel messaggio originale (vedi viewtopic.php?t=88590#p520116):

Codice: Seleziona tutto

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If nextR >= Now Then
    Application.OnTime nextR, "InFocusYN", , False
End If
End Sub


Il motivo per cui sono usate due flag (flag1 e InFoc) e' che, in quella discussione, io entrai in un secondo tempo, e Flag1 veniva usato per monitorare lo stato Attivo /Disattivo del file; per non modificare quel controllo ne aggiunsi un altro che lavorava in parallelo.

Ciao!

[patel]

Grazie, funziona ! avevo provato anche io a chiudere l'ontime col beforeclose, ma mi dava errore perché non avevo pensato a controllare che l'ontime fosse già stato avviato.
Io credo si possa semplificare così

Codice: Seleziona tutto

Public nextR, InFoc
 Private Declare Function GetActiveWindow Lib "user32" () As Long

 Sub InFocusYN()
    If GetActiveWindow <> Application.Hwnd Then
       If InFoc = True Then InFoc = Now()
    Else
       InFoc = True
    End If
    If InFoc <> True Then
        If InFoc + TimeValue("00:10:00") < Now Then
           ThisWorkbook.Close SaveChanges:=True
        End If
    End If

    DeltaT = "00:01:00" ' frequenza ripetizione macro - non andare sotto il minuto
    nextR = Now + TimeValue(DeltaT)
    Application.OnTime nextR, "InFocusYN" 
 End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If nextR >= Now Then
    Application.OnTime nextR, "InFocusYN", , False
End If
End Sub

Private Sub Workbook_Open()   'AGGIUNTA per lanciare InFocYN la prima volta
  Call InFocusYN
End Sub

[Anthony47]

Va bene anche cosi', ma le macro originali avevano l'obiettivo di liberare un file se "non utilizzato"; omettendo la gestione di Flag1 se io continuo a lavorare su Excel ma su un altro workbook il file non verra' liberato.

Ciao

[patel]

hai ragione come sempre, non ci avevo fatto caso, col flag1 è più completo.

[gua76]

Salve,
qualcuno sarebbe così cortese da fare un riepilogo passo passo per chi come me è ignorante di macro su excel, per permettere la chiusura automatica dei file dopo 15 min. ?

Rileggendo non ho ben chiaro dove vadano incollati i vari segmenti di codice...

Grazie

[Anthony47]

Prima di suggerirti una risposta, che non potra' essere comunque "da zero", vorrei sapere quale problema vorresti risolvere e in quale contesto.
Vorei insomma evitare ad aiutarti a mettere in piedi una cosa che fa danni invece che risolvere problemi....

Ciao

[Bat66]

Salve, riprendo questa discussione poiché sono interessato al codice per la chiusura a tempo di un file Excel condiviso con altri utenti.
Non ho ancora provato il codice postato poiché mi trovo fuori sede ma con tutta onestà non saprei dove posizionarlo, mi date una mano...? È valido per office 365 e Office 2016? o va cambiato qualche parametro? Grazie e complimenti.

[patel]

le dichiarazioni e la Sub InFocusYN() in un modulo standard, le altre nel modulo di ThisWorkbook

[Bat66]

Non so se ho incollato correttamente cmq mi da errore perchè il codice è da aggiornare per il 64bit

[Anthony47]

Se hai Excel 64bit allora modifica l'attuale dichiarazione:
invece che Private Declare Function GetActiveWindow Lib "user32" () As Long

userai:

Codice: Seleziona tutto

#If VBA7 Then
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
#Else
    Private Declare Function GetActiveWindow Lib "user32" () As Long
#End If


Ciao

[Bat66]

Ciao Anthony perdonami ☹ nel foglio attivando visual basic incollo in un modulo questo codice?:

Codice: Seleziona tutto

Public InFoc
Public Flag1
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
Sub InFocusYN()
    If GetActiveWindow <> Application.Hwnd Then
        If InFoc = True Then InFoc = Now()
    Else
        InFoc = True
    End If
'If Flag1 = False Then ThisWorkbook.Close SaveChanges:=True 'oppure False
If InFoc <> True Then
    If InFoc + TimeValue("00:15:00") < Now Then
    ThisWorkbook.Close SaveChanges:=True 'oppure False
    End If
End If
If Flag1 <> True Then     '**Vedi descrizione
    If Flag1 + TimeValue("00:15:00") < Now Then
'    ThisWorkbook.Close SaveChanges:=True 'oppure False
    End If
End If
DeltaT = "00:01:00"
Application.OnTime Now + TimeValue(DeltaT), "InFocusYN"
End Sub

E sotto la voce " questa cartella di lavoro "devo inserire questo?:

Codice: Seleziona tutto

Private Sub Workbook_Activate()    ' Gestione Flag1, INVARIATA
Flag1 = True
End Sub

Private Sub Workbook_Deactivate()   'Gestione Flag1, VARIATA
Flag1 = Now()
End Sub

Private Sub Workbook_Open()   'AGGIUNTA per lanciare InFocYN la prima volta
Flag1=True
Call InFocusYN
End Sub

Grazie

[Anthony47]

Devo rileggere quanto scrissi anni fa in questa e nell'altra discussione da cui l'utente Patel era partito, sperando di capire cosa intendevo... Nel frattempo se tu provi magari abbiamo anche un altro input...

Ciao

[Bat66]

Buongiorno....,si ho letto anche l' altra discussione. Ho creato un file ma non condiviso, ho inserito il codice sopra riportato ma non mi funziona. Delle volte il foglio diventa grigio delle volte resta normale. Bu...

[Anthony47]

Allora, mi pare che la procedura sia questa:
1) In un Modulo standard vuoto del file che vuoi chiudere se non risulta "Attivo" metti

Codice: Seleziona tutto

Public InFoc
Public Flag1
Public nextR
#If VBA7 Then
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
#Else
    Private Declare Function GetActiveWindow Lib "user32" () As Long
#End If


Sub InFocusYN()
Dim TimeOut As String
'
TimeOut = "00:10:00"      '<<< Max tempo di inattivita'; almeno 00:02:00 = 2 minuti
    If GetActiveWindow <> Application.Hwnd Then
        If InFoc = True Then InFoc = Now()
    Else
        InFoc = True
    End If
Debug.Print Format(Now, "hh:mm:ss"), "InFoc=" & InFoc
If InFoc <> True Then
    If InFoc + TimeValue(TimeOut) < Now Then
    Debug.Print "Chiusura per AA"
    ThisWorkbook.Close SaveChanges:=True 'oppure False
    End If
End If
If Flag1 <> True Then
Debug.Print 2, Flag1 + TimeValue(TimeOut), Now
   
    If Flag1 + TimeValue(TimeOut) < Now Then
    Debug.Print "Chiusura per BB"
    ThisWorkbook.Close SaveChanges:=True 'oppure False
    End If
End If
DeltaT = TimeValue("00:01:00")
nextR = Now + DeltaT
Application.OnTime nextR, "InFocusYN"
End Sub


2) Nel modulo QuestaCartellaDiLavoro dello stesso file metti:

Codice: Seleziona tutto

Private Sub Workbook_Activate()    ' Gestione Flag1
Flag1 = True
End Sub

Private Sub Workbook_Deactivate()   'Gestione Flag1
Flag1 = Now()
End Sub

Private Sub Workbook_Open()   'Lancia InFocYN la prima volta
Flag1 = True
Call InFocusYN
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If nextR >= Now Then
    Application.OnTime nextR, "InFocusYN", , False
End If
End Sub


Con queste impostazioni, dopo circa 10 minuti che non e' Attivo il file si chiudera' salvando le modifiche.

Per modificare il tempo di inattivita' si puo' modificare l'istruzione marcata <<<; non puo' essere pero' inferiore a 2 minuti, pari a 00:02:00

Ciao

[Bat66]

Anthony47 buongiorno e scusa se rispondo solo adesso.
Ieri in tarda giornata sono riuscito a provare il codice ma non mi funziona. Praticamente soltanto una volta dopo diversi minuti, nonostante abbia impostato il dato che mi Hai evidenziato a 00:02:00, il foglio èbdiventato grigio. Forse ci sono troppi moduli bu. Al momento devo risolvere un altra problematica poi riprendo col codice...Sai se funziona anche se il foglio viene caricato su ftp? Grazie 1000

[Anthony47]

Quanto proposto e' sviluppato per l'applicazioni desktop Excel, collaudata per Windows (non so come si comporta su Mac)
Tu che cosa usi?

[Bat66]

Uso windows ma soltanto una volta e dopo diversi minuti mi sono ritrovato con un foglio grigio... bu. Ti disturbo appena mi è chiaro come dover condividere il foglio. Grazie 1000

[Anthony47]

Perdona, ma tu usi Excel sul Pc windows? Perche' ancora non ho capito cosa sono i fogli grigi e i moduli bu

Per le istruzioni su come condividere un file guarda qui: viewtopic.php?f=26&t=103893&p=605487#p605487

Ciao

[zsadist]

.... non è che i fogli grigi.. sarebbero solo un excel aperto senza fogli attivi?
intervento veloce veloce solo per capire io stesso