Problème de partage fichier excel
Bonjour
Bonjour à tous,
je fais appel à votre compétence pour tenter de solutionner le problème ci-dessous
Sur un fichier de planning excel utilisé par un grand nombre de personnes se pose le problème régulier lié à l'oubli de fermer le fichier.
Le fichier restant ouvert n'est plus utilisable pour le reste des personnes en mode modification.
Est il possible par des lignes de commande VBA que le fichier puisse se fermer en s'enregistrant au bout d'un temps donné (Exemple 10mn)
Je vous remercie par avance de votre aide
Bien cordialement
Problème de partage fichier excel
Bonjour
Et merci pour la réponse, mais ces quelques lignes ne fonctionnent pas.
Cdlt
Problème de partage fichier excel
J'ai enfin trouver sur plusieurs liens les lignes de commandes qui fonctionnent.
Dans ThisWoorkbook
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14
| Option Explicit
'
Private Sub Workbook_BeforeClose(Cancel As Boolean)
mFermetureAuto.SupprimeInterruption
End Sub
Private Sub Workbook_Open()
mFermetureAuto.Programmation
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
ThisWorkbook.Names("Activité").Value = 1
End Sub |
Dans un module standard
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
| 'Identification des variantes Minutes et Secondes
' ce sont dans ces 2 lignes et uniquement celles-ci que l'on peut modifier le temps
'
Option Explicit
Option Private Module
'
'Temps d'inactivité maxi en minutes et secondes :
Const Minutes = 9 '0 à 59
Const Secondes = 0 '0 à 59
'
Sub Programmation()
Dim Heure As Date
Heure = Now + TimeValue("00:" & Format(Minutes, "00") & ":" & Format(Secondes, "00"))
ThisWorkbook.Names.Add Name:="HeureProchainControle", RefersTo:=Heure
ThisWorkbook.Names.Add Name:="Activité", RefersTo:=0
Application.OnTime Heure, "Interruption"
End Sub
Private Sub Interruption()
With ThisWorkbook
If .Sheets(1).Evaluate("Activité") = 0 Then
.Close SaveChanges:=True
Else
Programmation
End If
End With
End Sub
Sub SupprimeInterruption()
Dim Heure As Date
On Error Resume Next
Heure = ThisWorkbook.Sheets(1).Evaluate("HeureProchainControle")
Application.OnTime Heure, "Interruption", schedule:=False
End Sub |
Cela fonctionne visiblement, ici réglé sur 9 mn
Merci pour votre aide
Bien cordialement