Microsoft 365 Vba ouverture fermeture fichier excel

[denistoulon]

Bonjour,

J'aurai vraiment besoin d'une aide sur vba svp
Je recherche à savoir qui ouvre et referme un fichier excel
On me dit:
En VBA, en mettant deux macros Workbook_Open et Workbook_BeforeClose dans Thisworkbook, on peut enregistrer la date et l'heure de l'ouverture et fermeture ainsi que le nom du PC y ayant accéder avec Environ(N) qui peut vous donner le username, userdomain, ou encore l'IP du PC utilisateur.

Oui c'est ce que je cherche à faire mais je n'y arrive pas.

Quelqu'un a une solution pour m'aider?
Merci

 

[Jacky67]

Bonjour,

J'aurai vraiment besoin d'une aide sur vba svp
Je recherche à savoir qui ouvre et referme un fichier excel
On me dit:
En VBA, en mettant deux macros Workbook_Open et Workbook_BeforeClose dans Thisworkbook, on peut enregistrer la date et l'heure de l'ouverture et fermeture ainsi que le nom du PC y ayant accéder avec Environ(N) qui peut vous donner le username, userdomain, ou encore l'IP du PC utilisateur.

Oui c'est ce que je cherche à faire mais je n'y arrive pas.

Quelqu'un a une solution pour m'aider?
Merci

Bonjour,
Une proposition avec les codes ci-dessous.
Une feuille nommée "Mouchard" doit être créée, elle peut être masquée.

Private Sub Workbook_Open()
    With Sheets("Mouchard")
        .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, 1) = Now & " par " & Application.UserName & " sur le pc " & UCase(Environ("COMPUTERNAME"))
        .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 2) = "Fermeture sans enregistrement"
    End With
    ThisWorkbook.Save
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    With Sheets("Mouchard")
        .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 2) = Now & " par " & Application.UserName
    End With
End Sub

 

[denistoulon]

Bonjour,
Une proposition avec les codes ci-dessous.
Une feuille nommée "Mouchard" doit être créée, elle peut être masquée.

Private Sub Workbook_Open()
    With Sheets("Mouchard")
        .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, 1) = Now & " par " & Application.UserName & " sur le pc " & UCase(Environ("COMPUTERNAME"))
        .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 2) = "Fermeture sans enregistrement"
    End With
    ThisWorkbook.Save
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    With Sheets("Mouchard")
        .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 2) = Now & " par " & Application.UserName
    End With
End Sub

Bonsoir Jacky
Franchement c'est super! J'ai 2 questions pour toi. 1) est il possible de faire une exception? C'est à dire que si c'est moi qui l'utilise il n'inscrit rien. Pourquoi cette question? parce que moi je l'ouvre 10 fois dans une journée. si c'est possible c'est super! 2) Je le nettoie en supprimant les lignes? Merci pour ton aide précieuse

 

[Jacky67]

Bonsoir Jacky
Franchement c'est super! J'ai 2 questions pour toi. 1) est il possible de faire une exception? C'est à dire que si c'est moi qui l'utilise il n'inscrit rien. Pourquoi cette question? parce que moi je l'ouvre 10 fois dans une journée. si c'est possible c'est super! 2) Je le nettoie en supprimant les lignes? Merci pour ton aide précieuse

En début des deux macro tu mets

If Application.UserName = "Jacky" Then Exit Sub

En remplaçant "Jacky" par ton Username évidemment

 

[denistoulon]

En début des deux macro tu mets

If Application.UserName = "Jacky" Then Exit Sub

En remplaçant "Jacky" par ton Username évidemment

Merci beaucoup! j'essaye

 

[Jacky67]

Merci beaucoup! j'essaye

Re

Version avec "Remise à zéro'

 

[denistoulon]

Re

Version avec "Remise à zéro'

Merci mille fois. Demain je ne teste au travail! Au fait comment je fais pour l'integrer dans un fichier déjà fait? C'est peut-être idiot comme question

 

[Jacky67]

Merci mille fois. Demain je ne teste au travail! Au fait comment je fais pour l'integrer dans un fichier déjà fait? C'est peut-être idiot comme question

RE..
Il n'y a pas de question idiote
Conseil:
Toujours travailler sur une copie du classeur cible
Seulement après tests l'enregistrer avec son véritable nom

-Ouvrir les deux classeurs "une copie du fichier déjà fait" et "Version avec "Remise à zéro"
Dans le classeur ==>Version avec "Remise à zéro'
-Copier la feuille "Mouchard" (par clic droit sur le nom d'onglet) vers le classeur cible
-Touche alt+f11 toujours dans le classeur ==>Version avec "Remise à zéro'
-Dans la fenêtre de gauche, ouvrir ==>ThisWorkbook
-Copier les 2 macros qui se trouvent dans la fenêtre de droite et les coller dans le ThisWorkbook du classeur cible
-Enregistrer le classeur cible
Ne pas oublier de renseigner le username

 

[denistoulon]

RE..
Il n'y a pas de question idiote
Conseil:
Toujours travailler sur une copie du classeur cible
Seulement après tests l'enregistrer avec son véritable nom

-Ouvrir les deux classeurs "une copie du fichier déjà fait" et "Version avec "Remise à zéro"
Dans le classeur ==>Version avec "Remise à zéro'
-Copier la feuille "Mouchard" (par clic droit sur le nom d'onglet) vers le classeur cible
-Touche alt+f11 toujours dans le classeur ==>Version avec "Remise à zéro'
-Dans la fenêtre de gauche, ouvrir ==>ThisWorkbook
-Copier les 2 macros qui se trouvent dans la fenêtre de droite et les coller dans le ThisWorkbook du classeur cible
-Enregistrer le classeur cible
Ne pas oublier de renseigner le username

Merci pour ta réponse précise Je viens d'ouvrir le fichier à mon travail et il y a un truc que je ne comprends pas. J'ouvre le fichier et je l'enregistre puis je le ferme et il me redemande de l'enregistrer de nouveau . Si je ne lui dis pas "oui" il me dit quand je l'ouvre de nouveau: fermeture sans enregistrement. As tu une solution? Me suis je fait comprendre? Merci à toi

 

[Jacky67]

Merci pour ta réponse précise Je viens d'ouvrir le fichier à mon travail et il y a un truc que je ne comprends pas. J'ouvre le fichier et je l'enregistre puis je le ferme et il me redemande de l'enregistrer de nouveau . Si je ne lui dis pas "oui" il me dit quand je l'ouvre de nouveau: fermeture sans enregistrement. As tu une solution? Me suis je fait comprendre? Merci à toi

RE..
Essaye cette version
**Modifié

 

[denistoulon]

RE..
Essaye cette version

Bonjour Jacky merci pour ton soutien, l'enregistrement marche très bien maintenant. Par contre si tu consulte sans enregistrer, la ligne disparait et le message "Fermeture sans enregistrement" n'est plus présent. On ne voit pas qui consulte sans enregistrer.
Dans tout les cas, merci

 

[Jacky67]

Bonjour Jacky merci pour ton soutien, l'enregistrement marche très bien maintenant. Par contre si tu consulte sans enregistrer, la ligne disparait et le message "Fermeture sans enregistrement" n'est plus présent. On ne voit pas qui consulte sans enregistrer.
Dans tout les cas, merci

Oui.. , ce n'était pas la bonne version, reprend les codes du classeur #10

 

[denistoulon]

Oui.. , ce n'était pas la bonne version, reprend les codes du classeur #10

Hello Jacky avec toute ma bonne volonté (j'y suis depuis 2 heures) je n'y suis pas arrivé et j'en suis désolé Les codes #10

 

[Jacky67]

Hello Jacky avec toute ma bonne volonté (j'y suis depuis 2 heures) je n'y suis pas arrivé et j'en suis désolé Les codes #10

RE..
Ces codes à mettre dans le thisworkbook du classeur cible

Private Sub Workbook_Open()
    If Application.UserName = "Ton username" Then Exit Sub
    With Sheets("Mouchard")
        .Cells(.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1, 1) = Now & " par " & Application.UserName & " sur le pc " & UCase(Environ("COMPUTERNAME"))
        .Cells(.Cells.Find("*", , , , xlByRows, xlPrevious).Row, 2) = "Consultation"
    End With
    Application.EnableEvents = False: ThisWorkbook.Save: Application.EnableEvents = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Application.UserName = "Ton username" Then Exit Sub
    With Sheets("Mouchard")
        .Cells(Application.Max(2, .Cells(.Rows.Count, "A").End(xlUp).Row), 2) = Now & " par " & Application.UserName
    End With
End Sub

Toujours en adaptant Ton username

 

[denistoulon]

RE..
Ces codes à mettre dans le thisworkbook du classeur cible

Private Sub Workbook_Open()
    If Application.UserName = "Ton username" Then Exit Sub
    With Sheets("Mouchard")
        .Cells(.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1, 1) = Now & " par " & Application.UserName & " sur le pc " & UCase(Environ("COMPUTERNAME"))
        .Cells(.Cells.Find("*", , , , xlByRows, xlPrevious).Row, 2) = "Consultation"
    End With
    Application.EnableEvents = False: ThisWorkbook.Save: Application.EnableEvents = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Application.UserName = "Ton username" Then Exit Sub
    With Sheets("Mouchard")
        .Cells(Application.Max(2, .Cells(.Rows.Count, "A").End(xlUp).Row), 2) = Now & " par " & Application.UserName
    End With
End Sub

Toujours en adaptant Ton username

Merci infiniment pour ta patience et ton aide, ça marche. Bien à toi,