Discussion :

[CLAUDE19]

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

[User]

Bonjour,

Il y a des exemples sur le net, comme celui-ci :
http://excelribbon.tips.net/T008192_...nactivity.html

Pour le partage des données il y a aussi l'option de passer à Ms Access (convertir le planning au format Access) et d'utiliser le runtime qui est gratuit pour l'exécuter ?

Cdlt,

[CLAUDE19]

Bonjour

Et merci pour la réponse, mais ces quelques lignes ne fonctionnent pas.

Cdlt

[CLAUDE19]

J'ai enfin trouver sur plusieurs liens les lignes de commandes qui fonctionnent.


Dans ThisWoorkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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