Tempo si inactivité sur fichier

Bonjour j'aurais voulu savoir s'il était possible de créer une macro qui permettrait au bout de 5 min d'inactivité sur le fichier de revenir à une page précise (toujours la même, celle du sommaire)?

Si oui, comment?

Bonjour,

avec la fonction Application.OnTime en vba tu peux faire un timer et executer une macro après un temps déterminé. Donc tu pourrais configurer un timer et a chaque changement de la feuille, tu le réinitialises. C'est une solution, dis moi ce que tu en penses.

Je pense que cela devrait aller, j'avais créer ce code qui permettait de revenir a une page définie au bout du temps t, et ce code était dans le code de cette dernière :

Private Sub Worksheet_followhyperlink(ByVal Target As Hyperlink)

t = Timer

Do While Timer <= t + 5

DoEvents

Loop

Me.Select

End Sub

Comment fait-on pour appliquer ta solution, car je n'y connais pas grand chose en vba ^^

Merci

ton code empechera tout autre code de rouler. J'ai trouvé une bonne exemple de code avec OnTimer, la personne voulais faire sensiblement la même chose que toi.

euuuu...j'y comprend rien du tout il y a trop de truc, ces gars m'embrouille !!

Sans vouloir abuser de ta gentillesse, tu crois que tu pourrais me coller le ou les codes à entrer dans mon classeur et où je dois les mettre, parce que je ne suis que novice en VBA et la pour moi c'est du gros niveau ^^ .

Merci d'avance si jamais tu acceptes...

Cordialement

Mathieu

Bonjour,

Fais ceci dans ton fichier :

• Supprime le code que tu as posté sur ce fil
• vas dans VBA et ouvre THISWORKBOOK
• En dessous de Dim ok as boolean (veille bien à cela !!) mets le code ci-après

Const temps As Byte = 5
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim PauseTime As Byte
Dim Depart, Fin, TotalTemps
If Sh.Name = "SOMMAIRE" Then End
Depart = Timer
Do While Timer < Depart + temps
   DoEvents
Loop
Fin = Timer
TotalTemps = Fin - Depart
Sheets("SOMMAIRE").Activate
End Sub 

- Enregistre ton fichier

Amicalement

Dan

Super encore une fois !!

Saurais-tu par la même occasion créer un code qui au bout de 5 min, enregistre et ferme mon dossier car si quelqu'un oublie de le fermer les autres ordinateurs sont obligé d'y accéder en lecture seule.

Désolé, je fais pas le fainéant mais là ce sont des codes qui dépassent mes capacités ^^

Merci Dan

Amicalement

Mathieu

Bonjour bmxrider et Nad-Dan,

voici un petit code avec le OnTime

place ceci dans un module:

Dim HeureProgrammer As Double

Public Sub FermetureAuto()
    ActiveWorkbook.Close SaveChanges:=True
    Application.Quit
    'S'il y a plusieurs classeurs d'ouvert sur la même instance d'excel, il vont tous se fermer
    'Pour fermer uniquement le classeur actif, garde seulement la première ligne
    'Par contre excel va rester ouvert... a toi de voir
End Sub

Sub StartTimer()
    'Lance le timer une première fois
    HeureProgrammer = Now + TimeValue("00:00:10")
    Application.OnTime HeureProgrammer, "ExecutionTimer"
End Sub

Public Sub ExecutionTimer()
    'Place ici le code à effectuer
    FermetureAuto
End Sub

Public Sub ReiniTimer()
    'Arrete le timer
    Application.OnTime EarliestTime:=HeureProgrammer, Procedure:="ExecutionTimer", Schedule:=False

    'Le relance avec un nouvelle heure
    HeureProgrammer = Now + TimeValue("00:00:04")
    Application.OnTime HeureProgrammer, "ExecutionTimer"
End Sub

et ceci dans ThisWorkbook

Private Sub Workbook_Open()
    StartTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ReiniTimer
End Sub

qu'est ce que tu veux faire au juste après 5min d'inactivité? Retour à une feuille précise ou sauvegarde et fermeture du classeur?

bonne journée et si tu as des questions sur le code hésite pas

désolé j'ai fais une erreur en copiant le code, j'avais configurer mon timer sur 4sec pour le tester... change c'est ligne:

HeureProgrammer = Now + TimeValue("00:00:10")

et

HeureProgrammer = Now + TimeValue("00:00:04")

par

HeureProgrammer = Now + TimeValue("00:05:00")

au bout de 5 min je voulai sauvegarder automatiquement puis fermer le fichier

euuu...comment on fait pour rentrer un code dans un module parce que je sais même pas ce qu'est un module.

Merci

Amicalement

Mathieu

alt+F11 pour ouvrir l'éditeur vba,

ensuite insertion - module , tu peux copier le code la

sur le coté gauche tu as un liste des feuilles de ton classeur, clique avec bouton de droit sur ThisWorkbook et sélectionne "Code". Colle la deuxième partie du code là.

dis-moi si ca fonctionne

Re,

Attention que tu as déjà des macros OPEN et SELECTION SHEET dans THISWORKBOOK qui vont interférer avec ce que Math te propose.

Il faut revoir le code complet afin de vérifier et d'imbriquer les deux codes.

Amicalement

Dan

ok merci dan...

Si je vous laisse le fichier en version non modifié (V1) et version modifiée(V2) vous voulez bien jetez un coup d'oeil car vraiment là je ne suis plus du tout...

Merci encore

Amicalement

Mathieu

https://www.excel-pratique.com/~files/doc2/WbQpeMAGASIN_V1.zip

https://www.excel-pratique.com/~files/doc2/M8x63MAGASIN_V2.zip

bonjour,

le problème c'est que tu appelles le même évènement plusieurs fois dans ThisWorkbook.

( l'évènement Open par exemple ). Le code de ThisWorkbook:

Private Sub Workbook_Open()
worksheets("SOMMAIRE").Activate
StartTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ReiniTimer
End Sub

Private Sub workbook_Close()
ActiveWorkbook.Save
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'Macro modifiée par Dan le 26/05/09
If ActiveSheet.Name = "SOMMAIRE" Or ActiveSheet.Name = "COMMANDES" _
Or ActiveSheet.Name = "FOURNISSEURS" Or ActiveSheet.Name = "CONVERSION INCH CM" Then Cancel = True: Exit Sub
If Not Intersect(Range("$I$3:$I$100"), Target) Is Nothing Then
On Error Resume Next
If IsEmpty(ActiveCell.Value) Then
ActiveCell.Value = "P"
ElseIf ActiveCell.Value = "P" Then
ActiveCell.Value = ""
End If
End If
Cancel = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Macro Dan pour xlpratique le 26/05/09
Dim lgfr As Integer
If ok = True Then Exit Sub
If Not Intersect(Target, Range("G3:G" & Range("G65536").End(xlUp).Row)) Is Nothing Then
On Error GoTo Fin
With Sheets("FOURNISSEURS")
lgfr = Application.WorksheetFunction.Match(Target, _
    .Range("A2:A" & .Range("A65536").End(xlUp).Row + 1), 0)
ok = True
Target.Offset(0, -1) = .Cells(lgfr + 1, 2)
End With
End If
ok = False
Exit Sub
Fin:
MsgBox "Il n'y a pas de fournisseur pour cet article"
End Sub

oublie pas d'aller changer les intervalles de temps dans le module ou tu as copier ma macro :

HeureProgrammer = Now + TimeValue("00:05:00")

j'ai pas garder le code de Dan, mais sent toi libre d'utiliser celui que tu veux, les deux fonctionne.

ok merci math

le problème est que même s'il y de lactivité sur le fichier celui ci se ferme, or moi je veux qu'il se ferme en cas d'inactivité sur le fichier. D'après ce que j'ai compris dans le code, la seul activité détectée est celle des changement de feuille. Comment faire pour qu'il détecte les autre activité comme les doubles clics ou la modification d'une cellule??

Merci

Amicalement Mathieu

bonjour,

le code qui reinitialise le timer est celui-ci

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 
    ReiniTimer 
End Sub 

c'est à dire à chaque fois que la selection change, on reinitialise, pas seulement quand on change de feuille mais à chaque changement de cellule. C'est ce qu'on peut faire ( je crois ) de plus précis avec les évènements de Excel. Il y a d'autre moyen de détecter l'inactivité global de l''ordi, mais c'est un peu plus complexe et je ne crois pas que dans ton cas ce soit utile.

bonne journée.

ok super

merci beaucoup math

et est-ce que dans ce code on pourrait ajouter une commande qui au bout de deux minute d'inactivité revienne à la page "sommaire", un intermédiaire dirons nous avant la fermeture du fichier prévu à 5 min d'inactivité.

Merci

et en ce qui concerne la fermeture du classeur , la commande ferme le classeur actif, au lieu de cela, existerait-il une commande qui reconnaitrait le nom de mon fichier du genre

activeworkbook("magasin V1").close à la place de activeworkbook.close

je ne sais pas si c'est assez clair alors redis moi...

Merci

Amicalement

Mathieu

bonjour, pour la fermeture du classeur sélectionné, remplace les lignes :

ActiveWorkbook.Close SaveChanges:=True 

de la procedure FermetureAuto par

Workbooks("Nom du classeur").Close SaveChanges:=True

pour l'activation de la feuille après 2 minutes, il suffit de lancer un deuxième Timer après 2 minutes. Remplace le code du module que je t'ai envoyé hiers par celui ci:

Dim HeureProgrammer As Double
Dim FinTimer1 As Boolean

Public Sub FermetureAuto()
    Workbooks("magasin V1").Close SaveChanges:=True
    Application.Quit
End Sub

Sub StartTimer()
    'Lance le timer une première fois
    HeureProgrammer = Now + TimeValue("00:02:00")
    Application.OnTime HeureProgrammer, "StartTimer2"
End Sub

Sub StartTimer2()
    'Lance le deuxieme timer
    FinTimer1 = True
    Sheets("sommaire").Activate
    HeureProgrammer = Now + TimeValue("00:03:00")
    Application.OnTime HeureProgrammer, "FermetureAuto"
End Sub

Public Sub ReiniTimer()
    'Arrete le timer
    If Not FinTimer1 Then
        Application.OnTime EarliestTime:=HeureProgrammer, Procedure:="StartTimer2", Schedule:=False
    Else
        Application.OnTime EarliestTime:=HeureProgrammer, Procedure:="FermetureAuto", Schedule:=False
    End If

    'Le relance avec un nouvelle heure
    HeureProgrammer = Now + TimeValue("00:02:00")
    Application.OnTime HeureProgrammer, "StartTimer2"
    FinTimer1 = False
End Sub

bonne journée

Tout marche comme sur des roulettes, c'est parfait

Merci à vous deux.

Amicalement

Mathieu