Tester réponse boite de dialogue prédéfinie "voulez-vous enregistrer"

**quentinvba** · 04/09/2015, 10h52

Bonjour à tous,

J'utilise actuellement l'événement Workbook_BeforeClose.

Je souhaite que des instructions aient lieu si le document est effectivement fermé juste après. Or si l'on clique sur la croix pour fermer, puis réponse "annuler" à la boite de dialogue "voulez vous sauvegardez les modifs ?" le document reste ouvert et l'événement a pourtant lieu.

Ainsi ,est-il possible de tester la réponse à cette boite de dialogue prédéfinie ? (pour que je puisse mettre : si "annuler" alors Exit Sub)

Existe-il une autre méthode ? (sans passer par alertsdisplay + création MsgBox perso + tester cette MsgBox)

PS : J'ai bien trouvé le sujet suivant mais il est inachevé :

http://www.developpez.net/forums/d20...modifications/

Je vous remercie par avance, bonne journée !

Quentin

**Thautheme** · 04/09/2015, 11h22

Bonjour Quentin, bonjour le forum,

C'est plus que logique !... Tu fermes un fichier édité non enregistré et un message te propose trois option : Enregistrer, Ne pas enregistrer et Annuler (la fermeture). Si tu cliques sur Annuler, c'est normal que le fichier reste ouvert ! Non ? Ou alors je n'est pas bien compris (ce qui n'est pas rare)...

**quentinvba** · 04/09/2015, 11h37

Bonjour Thautheme,

Merci pour ton intérêt !

Ca ne me pose pas de problème que le fichier reste ouvert dans le cas où l'on clique sur "annuler".

Ce qui en revanche est un problème : mes instructions liées à l'événement BeforeClose se déclenchent quand même dans ce cas ! (alors que le document reste ouvert puisque l'utilisateur a cliqué sur "annuler").

Il semble que BeforeClose se déclenche en fait au moment précis où on l'on clique sur la croix, et non à l'instant effectif où le document est sur le point de se fermer.

Je reste à ta disposition pour toute autre explication ou pour te fournir mon bout de code si besoin

.

Invité · 04/09/2015, 11h42

Bonjour

Code Page d’accueil :

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

1
2
3
4
Private Sub Quitter_Click()
IsSvaved = True
ThisWorkbook.Close False
End Sub

Code ThisWorkbook :

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

1
2
3
 Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Not IsSvaved
End Sub

Code Module1 :

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

 Public IsSvaved As Boolean

**quentinvba** · 07/09/2015, 10h42

Bonjour rdurupt !

Merci beaucoup pour ton aide

.

Ta solution n'est pas tout à fait celle que je recherche mais s'en approche beaucoup. En effet, elle permet d'empêcher la fermeture et de tester si l'utilisateur a bien quitté le classeur en cliquant sur "Quitter". La méthode est donc très semblable à celle avec alertdisplay mentionnée dans mon premier post.

En fait le but de ma procédure est de tester si un utilisateur du réseau a bien fermé le classeur (sans modifier ses habitudes de fermeture du classeur notamment). Ainsi, j'aimerai que "OK" s'inscrive dans une case quand le classeur est bel et bien fermé par la méthode classique.

Voici le bout de procédure correspondant :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
Dim Feuille As String
 
Feuille = ActiveSheet.Name
Sheets("Indics ouverture").Activate
Sheets("Indics ouverture").Range("A3").End(xlDown).Offset(0, 3).Value = "OK"
 
Worksheets(Feuille).Activate
 
End Sub

Cela fonctionne SAUF si l'utilisateur clique sur la croix puis sur "annuler" où "OK" s'inscrit tout de même dans la case sélectionnée.

Quelqu'un a-t-il une autre piste ?

Invité · 07/09/2015, 11h25

bonjour,

Code :

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

1
2
3
4
5
6
7
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "OK"
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Indics ouverture" Then ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "KO"
End Sub

le problème est que si l'utilisateur ferme sens sauvegarde?????
tu peux faire un mixte des deux!

Code :

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

1
2
3
 Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = Not IsSvaved
End Sub

Code :

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

1
2
3
4
5
6
7
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
IsSvaved=true
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
IsSvaved=false
End Sub

**quentinvba** · 07/09/2015, 14h23

Non rdurupt ce n'est pas ce problème, dommage car ta solution était très bien.

Le but est que je puisse contrôler que le document ait bien été fermé par l'utilisateur.

PB : je ne peux me fier à l'obligation d'ouvrir en lecture seule si le classeur a été ouvert en écriture par l'autre utilisateur. En effet, son ordinateur (portable) n'est pas toujours en réseau (notre réseau étant filaire, l'ordinateur étant déplacé). Ainsi, si l'utilisateur ouvre le classeur, puis se déplace hors réseau, je peux ouvrir le classeur en écriture sans avoir aucune alerte.

A noter que l'autre utilisateur sauvegarde et ferme le classeur uniquement en étant en réseau.

Je souhaitais donc savoir quand le classeur est ouvert et fermé, mais peut être y a t il une autre méthode pour faire ce que je souhaite

.

Je reste à ta dispo pour d'autres infos !

Invité · 07/09/2015, 16h52

tu peux faire un fichier de log!
http://www.developpez.net/forums/d15...l/#post8149786

**Docmarti** · 07/09/2015, 18h40

Bonjour à tous

Si le fichier a été modifié, appeler le code à partir de Workbook_BeforeSave, sinon à partir de Workbook_BeforeClose.

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
Dim AfficherBeforeCloseSVP
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
 If AfficherBeforeCloseSVP = True Then
  Call AfficherBeforeClose
 End If
 
End Sub
 
Sub AfficherBeforeClose()
 MsgBox "Message a la fermeture"
 
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
 If Me.Saved = False Then
  AfficherBeforeCloseSVP = True
 Else
  AfficherBeforeCloseSVP = False
  Call AfficherBeforeClose
 End If
 
End Sub

**quentinvba** · 08/09/2015, 14h28

Envoyé par rdurupt

tu peux faire un fichier de log!
http://www.developpez.net/forums/d15...l/#post8149786

Bonjour rdurupt,

J'avais déjà fait quelque chose s'approchant du log :

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
 
Private Sub Workbook_Open()
 
Dim Feuille As String
 
Feuille = ActiveSheet.Name
 
Worksheets("Indics ouverture").Activate
 
Dim Nom As String
Nom = Environ("Username")
 
    If ActiveWorkbook.ReadOnly = False Then
        If Range("A4").Value = "" Then
        Range("A4").Value = Now()
        Else
        Worksheets("Indics ouverture").Range("A3").End(xlDown).Offset(1, O).Value = Now()
        End If
     Sheets("Indics ouverture").Range("A3").End(xlDown).Offset(0, 1).Value = Nom
    End If
 
Worksheets(Feuille).Activate
 
End Sub

Donc j'ai un peu de mal à voir comment utiliser le log pour être sûr que l'autre utilisateur ait fermé le classeur

(à moins qu'on puisse avoir un fichier type delog !)

Merci pour toutes tes propositions en tout cas, on va surement y arriver

!

PS : J'ai essayé avec Userstatus, malheureusement cela ne détecte pas l'utilisateur qui a ouvert le classeur puis quitté le réseau avec son ordi portable (on aurait pu s'y attendre en effet !)

**quentinvba** · 08/09/2015, 14h33

Envoyé par Docmarti

Bonjour à tous

Si le fichier a été modifié, appeler le code à partir de Workbook_BeforeSave, sinon à partir de Workbook_BeforeClose.

Salut Docmarti,

Pas bête ! Si j'ai bien compris, cela permet de conserver la fermeture classique et en même temps d'intégrer une MsgBox à tester pour s'assurer de la fermeture effective du classeur ???!

Je test et je reviens vers vous !

Invité · 08/09/2015, 14h50

Bonjour,
si ti fait ça Worksheets("Indics ouverture").Range("A3").End(xlDown).Offset(1, O).Value = Now()! et que l'utilisateur ferme sens en registre, comment récupert tu l'information?

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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim WinXp As New clsWindowsExporer
 
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", "Fermer par : " & Environ("UserName") & " à : " & Now & vbCrLf
Set WinXp = Nothing
End Sub
 
Private Sub Workbook_Open()
Dim WinXp As New clsWindowsExporer
If WinXp.Fichier_Exist(ActiveWorkbook.Path & "\FichierLog.log") = True Then
    f = WinXp.OuvrirFichier(ActiveWorkbook.Path & "\FichierLog.log")
    If InStr(1, f(UBound(f) - 1), "Ouvert par") <> 0 Then MsgBox f(UBound(f) - 1)
End If
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", "Ouvert par : " & Environ("UserName") & " à : " & Now & vbCrLf
Set WinXp = Nothing
End Sub

Code clsWindowsExporer :

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe(Repertoires)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Repertoires_Existe = fso.FolderExists(Repertoires)
Set fso = Nothing
End Function
'Taille d'un répertoire
Public Function Taille_Repertoire(Repertoire)
Dim fso
Dim Rep
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Taille_Repertoire = Rep.Size
End Function
Function Repertoire_Date_Creation(Repertoire)
  Dim fso
Dim Rep
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Repertoire_Date_Creation = Rep.DateCreated
End Function
'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
Public Sub Creer_Repertoires(NewRepertoires)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim t
Dim R
Dim I
R = ""
t = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(t) - 1
    If Trim("" & t(I)) <> "" Then
        R = R & Trim("" & t(I))
        If Repertoires_Existe(R) = False Then fso.CreateFolder "" & R
    End If
     R = R & "\"
Next
Set fso = Nothing
End Sub
'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
Public Sub Copie_Repertoires(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder Source, Destination, True
Set fso = Nothing
End Sub
'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
Public Function Deplace_Repertoire(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.MoveFolder Source, Destination
If Err > 0 Then Deplace_Repertoire = Err.Description
Err.Clear
On Error GoTo 0
Set fso = Nothing
End Function
'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
Public Sub Supprimer_Repertoire(DelRepertoire)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder DelRepertoire, True
Set fso = Nothing
End Sub
'Taille d'un répertoire
Public Function Taille_Fichier(Fichier)
Dim fso
Dim Fich
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fich = fso.GetFile(Fichier)
    Taille_Fichier = Fich.Size
End Function
'Vérifie lexistance d'un   fichier
Public Function Fichier_Exist(Fichier)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Exist = fso.FileExists(Fichier)
Set fso = Nothing
End Function
'Retourne le nom du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_Name(Fichier)
Dim fso
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Name = fso.GetBaseName(Fichier)
Set fso = Nothing
End If
End Function
'Retourne l'extension du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_extension(Fichier)
Dim fso
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_extension = fso.GetExtensionName(Fichier)
Set fso = Nothing
End If
End Function
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Source, Destination, True
Set fso = Nothing
End Sub
'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
Public Sub Deplace_Fichier(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile Source, Destination
Set fso = Nothing
End Sub
'Supprime le ou les fichiers dont le nom est précisé en argument.
Public Sub Supprimer_Fichier(DelFichier)
If Fichier_Exist(DelFichier) = True Then
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile DelFichier, True
Set fso = Nothing
End If
End Sub
Function AppendTxt(sFile, sText)
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(sFile, 8)
NewFichier.Write sText
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Function
Public Sub FichierLog(sFile, txt)
Dim FichierLog, fso
FichierLog = sFile
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(FichierLog) = False Then EnteteFichier FichierLog
AppendTxt FichierLog, txt
Set fso = Nothing
End Sub
Private Sub EnteteFichier(Fichier)
Dim txt, fso, NewFichier
txt = "***********************************************************************************************************************************************************************************"
txt = txt & vbCrLf
txt = txt & ""
txt = txt & vbCrLf
txt = txt & "   Date de création: " & Day(Now) & "/" & Month(Now) & "/" & Year(Now) & " " & Hour(Time) & ":" & Minute(Time) & vbCrLf
txt = txt & vbCrLf
txt = txt & "   " & Fichier
txt = txt & vbCrLf
txt = txt & "***********************************************************************************************************************************************************************************"
txt = txt & vbCrLf
txt = txt & vbCrLf
txt = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write txt
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Sub
Public Function OuvrirFichier(Fichier)
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(Fichier)
OuvrirFichier = Split(oFile.ReadAll, vbCrLf)
oFile.Close
End Function

**quentinvba** · 08/09/2015, 15h25

Oui tu as raison, pas moyen de récupérer l'info dans ce cas !

Dis moi, avec ton code, si le user clique sur la croix du classeur puis "Annuler", cela sera tout de même répertorié dans le Log non, car toujours associé à l'event BeforeClose ? (et le fichier toujours ouvert)

Invité · 08/09/2015, 15h38

Il pour l'instant je tour en rond!
car si tu click sur la croix tu passe dans

Code :

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

Private Sub Workbook_BeforeClose(Cancel As Boolean)

!

si tu travail

Code :

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

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

c'est cool si l'utilisateur fait des modifications après!

dans ce cas, li faut intervenir sur

Code :

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

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

jeveux pas imaginer la taille du fichier de log au bout d'un mois!!!

Édite:un compromise entre nos solution!

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
dim IsSvaved as boolean
Private Sub Workbook_BeforeSave(l SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "Fermer par : " & Environ("UserName") & " à : " & Now
If IsSvaved = True then
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value & vbCrLf
Set WinXp = Nothing
 
End if
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Indics ouverture" Or ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Address <> Target.Address Then ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "Ouvert par : " & Environ("UserName") & " à : " & Now
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim WinXp As New clsWindowsExporer
 IsSvaved = true
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value & vbCrLf
Set WinXp = Nothing
End Sub
 
Private Sub Workbook_Open()
ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "Ouvert par : " & Environ("UserName") & " à : " & Now
Dim WinXp As New clsWindowsExporer
If WinXp.Fichier_Exist(ActiveWorkbook.Path & "\FichierLog.log") = True Then
    f = WinXp.OuvrirFichier(ActiveWorkbook.Path & "\FichierLog.log")
    If InStr(1, f(UBound(f) - 1), "Ouvert par") <> 0 Then MsgBox f(UBound(f) - 1)
End If
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value & vbCrLf
Set WinXp = Nothing
End Sub

**quentinvba** · 09/09/2015, 08h58

Bonjour rdurupt,

J'aimerai tester ce compromis !

Il faut donc que je couple ce code avec le code clsWindowsExporer écrit précédemment je suppose.

Quelques questions tout de même car ce dernier dépasse mes compétences :

- Repertoires : il s'agit du nom du dossier où le fichier log sera créé ? (je pourrai donc mettre "Dossier pour log")
- Sub Créer_Répertoires (Newrepertoires) : je remplace "Newrepertoires" par quelque chose du style : "C:\Users\Desktop\Dossier pour log" ?
- Source et Destination : Que dois je mettre à la place ? Je ne comprends pas la nuance entre Destination et Dossier pour log par exemple.
- Fichier : pas besoin de le remplacer, non ?

Merci par avance,

Quentin

Invité · 09/09/2015, 09h56

Bonjour,

Envoyé par quentinvba

Bonjour rdurupt,

J'aimerai tester ce compromis !

Il faut donc que je couple ce code avec le code clsWindowsExporer écrit précédemment je suppose.

Re:Oui,si j'enregistre ouvert ou fermer à sur les événement open et close, j'enregistre la valeur fermer quand je click sur la croix! hors si j’annule au message d'alerte , c'est trop tard!

Quelques questions tout de même car ce dernier dépasse mes compétences :

- Repertoires : il s'agit du nom du dossier où le fichier log sera créé ? (je pourrai donc mettre "Dossier pour log")
- Sub Créer_Répertoires (Newrepertoires) : je remplace "Newrepertoires" par quelque chose du style : "C:\Users\Desktop\Dossier pour log" ?
Re: si tu veux créer sur le bureau de l’utilisateur, utilise la fonction Environ("Userprofile") & "\Desktop\FichierLog.log", attention si un autre utilisateur ouvre le fichier XLS il n’aura pas accès aux information!
ActiveWorkbook.Path & "\FichierLog.log" permet de placer le fichier de log dans le reetoitre due XLS, ainsi tous les utilisateur y ont acès!
- Source et Destination : Que dois je mettre à la place ? Je ne comprends pas la nuance entre Destination et Dossier pour log par exemple.
- Fichier : pas besoin de le remplacer, non ?

Merci par avance,

Quentin

ici on retrouve le code dans l’esprit de ce que tu avais fait!

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "Fermer par : " & Environ("UserName") & " à : " & Now
If IsSvaved = True Then 'la on rerouve ce que j'avais proposé la première fois!
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value & vbCrLf
Set WinXp = Nothing
 
End If
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Indics ouverture" Or ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Address <> Target.Address Then ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "Ouvert par : " & Environ("UserName") & " à : " & Now
End Sub

la on retrouve l'esprit du fichier de log!

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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim WinXp As New clsWindowsExporer
 IsSvaved = True
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value & vbCrLf
Set WinXp = Nothing
End Sub
 
Private Sub Workbook_Open()
Dim WinXp As New clsWindowsExporer
If WinXp.Fichier_Exist(ActiveWorkbook.Path & "\FichierLog.log") = True Then
    f = WinXp.OuvrirFichier(ActiveWorkbook.Path & "\FichierLog.log")
    If InStr(1, f(UBound(f) - 1), "Ouvert par") <> 0 Then MsgBox f(UBound(f) - 1)
End If
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", "Ouvert par : " & Environ("UserName") & " à : " & Now & vbCrLf
Set WinXp = Nothing
End Sub

**quentinvba** · 10/09/2015, 10h19

Bonjour !

Ca a l'air pas mal du tout, pas de "fermer par" lorsque on clique sur annuler par exemple !

Un petit problème persiste :

Code :

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

1
2
3
4
5
6
7
8
9
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "Fermer par : " & Environ("UserName") & " à : " & Now
If IsSvaved = True Then
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value & vbCrLf
Set WinXp = Nothing
 
End If
End Sub

Où à la ligne 5 j'ai avec le débog : erreur 424 "objet requis" je ne sais pas vraiment pourquoi !

Invité · 10/09/2015, 10h22

Bonjour,

Code Désolé! :

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

1
2
3
4
5
6
7
8
9
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value = "Fermer par : " & Environ("UserName") & " à : " & Now
If IsSvaved = True Then
Dim WinXp As New clsWindowsExporer
WinXp.FichierLog ActiveWorkbook.Path & "\FichierLog.log", ThisWorkbook.Sheets("Indics ouverture").Range("A" & Cells.Rows.Count).End(xlUp).Offset(0, 3).Value & vbCrLf
Set WinXp = Nothing
 
End If
End Sub

**quentinvba** · 10/09/2015, 10h35

Plus de bug dans la macro, merci

!

Par contre je viens de remarquer qu'en enregistrant simplement en cliquant sur la disquette, le log me renvoie "fermer par"

.

Invité · 10/09/2015, 10h47

quand tu ouvre ton xls le fichier de log reçois ouvert

quand tu referme ton xls le de log reçois le contenu de la cellule (Ouvert/fermer)!

quand tu sauvegardes la cellule reçois fermer mais tu ne dis rien au fichier de log!

si tu referme ton Xls pas de message vue que tu a sauvegarde mais le fichier de log reçoit e contenu de la cellule ferme!

si tu modifies ton xls ta cellule reçoit ouver!

si tu referme ton Xls le fichier de log reçoit ouvert, tu à le message si tu annule c'est fini si tu dit sauvegarder, la cellule reçois fermer ton fichier de log reçoit le contenu de ta cellule (Ferme)

Tester réponse boite de dialogue prédéfinie "voulez-vous enregistrer"

Macros et VBA Excel

Discussions similaires

Partager

Partager