enregistrer classeur si modif

KEUDJ

KEUDJ

XLDnaute Junior
Bonjour le Forum,

dans un classeur j`utilise cette macro pour savoir qui a modifie le fichier en dernier.

Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
user = Environ("username")
   Sheets("status").Range("A1").Value = " Modified by: " & _
        user & " on " & Format(Date, "dddd dd mmmm") & _
" at " & Format(Now, "hh:mm")
ActiveWorkbook.Save
End Sub

je souhaite ameliorer cette macro de sorte que l`enregistrement soit effectue uniquement si modif du classeur:

j`ai essaye ceci mais ca ne marche pas,

Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
user = Environ("username")
If modif = True Then
   Sheets("status").Range("A1").Value = " Modified by: " & _
        user & " on " & Format(Date, "dddd dd mmmm") & _
" at " & Format(Now, "hh:mm")
ActiveWorkbook.Save
End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
modif = True
End Sub

de plus le top serais de creer une copie du fichier si modif :
ajout de qq ligne

Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim nom As String
user = Environ("username")
nom = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 20) & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmm") & ".xls"
'If modif = True Then
Sheets("status").Range("A1").Value = " Modified by: " & user & " on " & Format(Date, "dddd dd mmmm") & " at " & Format(Now, "hh:mm")
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
'End If
End Sub

'Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'modif = True
'End Sub

le fichier est bien renomer, mais a chaque fois excel me deamnde confirmation de l`enregistrement.

en resume, pouvez vous me donner un coup de pouce dans le but de:
--> si modif du classeur forcer l`enregistrement a la fermeture en ajoutant date et heure au nom de fichier, idem + username sur "status"

en vous remerciant d`avance pour votre aide

@+
 

Pièces jointes

  • test_05-08-2008_1045.zip
    14.5 KB · Affichages: 18
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Re : enregistrer classeur si modif

Bonjour à tous, bonjour keudj,
Utiliser la propriété Saved qui renvoie True si le classeur n'a pas été modifié depuis le dernier enregistrement :
Code: 
If Not ActiveWorkbook.Saved Then
-------------
End If
A+
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : enregistrer classeur si modif

bonjour,
Si on garde le principe (mais ça ne gère que les chgts de valeurs)
Dim modif As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
user = Environ("username")
If modif = True Then
Sheets(1).Range("A1").Value = " Modified by: " & _
user & " on " & Format(Date, "dddd dd mmmm") & _
" at " & Format(Now, "hh:mm:ss")
ActiveWorkbook.Save
End If
End Sub

Private Sub Workbook_Open()
modif = False
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
modif = True
End Sub
Cliquez pour agrandir...

De plus pour la copie on ne sais pas de quel fichier il s'agit
A+
kjin
 
Vote positif 0 Vote négatif
KEUDJ

KEUDJ

XLDnaute Junior
Re : enregistrer classeur si modif

bonjour le forum, job75 & kjin

Kjin, ta solution fonctionne, mais demande confirmation de l`enregistrement
est-il possible de supprimer la fentre de dialoge? et de forcer l`enregistrement a la fermeture si modif?


Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim nom As String
user = Environ("username")
nom = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 20) & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmm") & ".xls"
If Not ActiveWorkbook.Saved Then
Sheets("status").Range("A1").Value = " Modified by: " & user & " on " & Format(Date, "dddd dd mmmm") & " at " & Format(Now, "hh:mm")
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
End If
End Sub

job75, copie du workbook actif, le comportement n`a pas change avec ta modif.

merci pour votre aide

@+
 
Vote positif 0 Vote négatif
KEUDJ

KEUDJ

XLDnaute Junior
Re : enregistrer classeur si modif

Re le Forum ...

Kjin, en modifiant Saveascopy pae Saveas ca roule.

mais helas je ne vous avais pas tout dit:


Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim nom As String
Application.ScreenUpdating = False
user = Environ("username")
nom = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 20) & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmm") & ".xls"
Sheets(1).Visible = True
For i = Sheets.Count To 2 Step -1
Sheets(i).Visible = xlVeryHidden
Next i
If Not ActiveWorkbook.Saved Then
user = Environ("username")
   Sheets("status").Range("A1").Value = " Modified by: " & _
        user & " on " & Format(Date, "dddd dd mmmm") & _
" at " & Format(Now, "hh:mm")
ActiveWorkbook.[COLOR="Blue"]SaveAs[/COLOR] ActiveWorkbook.Path & "\" & nom
End If
'ActiveWorkbook.Save
End Sub

Private Sub Workbook_Open()
Application.ScreenUpdating = False
For Each sh In Sheets
sh.Visible = True
Next sh
Sheets(1).Visible = xlVeryHidden
Sheets("ref").Visible = xlVeryHidden

End Sub


apres avoir inclus dans mon fichier, une macro deja presente force l`utilisateur a activer les macros, du coup la solution If Not ActiveWorkbook.Saved Then considere que le fichier a ete modifie et sauvegarde systematiquement.

je ne sais pas si il y a une actuce mais je reviens au poste initiale utilisant: Workbook_SheetChange

quelqu'un a une idee?

merci @+
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : enregistrer classeur si modif

bonjour,
Essaie en ajoutant la ligne verte ci dessous
Dim modif As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
user = Environ("username")
If modif = True Then
Sheets(1).Range("A1").Value = " Modified by: " & _
user & " on " & Format(Date, "dddd dd mmmm") & _
" at " & Format(Now, "hh:mm:ss")
Application.DisplayAlerts = False
ActiveWorkbook.Save
End If
End Sub

Private Sub Workbook_Open()
modif = False
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
modif = True
End Sub
Cliquez pour agrandir...
Pour la copie, tourjours pas de précision
A+
kjin

Edit : La variable "modif" doit être déclarée avant la première sub de la feuille "Thisworkbook"
 
Dernière édition:
Vote positif 0 Vote négatif
KEUDJ

KEUDJ

XLDnaute Junior
Re : enregistrer classeur si modif

Bonjour le Forum, Kjin,

voir code modifie ci dessous, mais toujours le meme PB et demande de confirmation

Code: 
Private Sub Workbook_Open()
Application.ScreenUpdating = False
For Each Sh In Sheets
Sh.Visible = True
Next Sh
Sheets(1).Visible = xlVeryHidden
Sheets("ref").Visible = xlVeryHidden
modif = False
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
modif = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim nom As String
Application.ScreenUpdating = False
user = Environ("username")
nom = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 20) & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmm") & ".xls"
Sheets(1).Visible = True
For i = Sheets.Count To 2 Step -1
Sheets(i).Visible = xlVeryHidden
Next i
If modif = True Then
user = Environ("username")
   Sheets("status").Range("A1").Value = " Modified by: " & _
        user & " on " & Format(Date, "dddd dd mmmm") & _
" at " & Format(Now, "hh:mm")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & nom
End If
End Sub

Pour la copie, tourjours pas de précision
Cliquez pour agrandir...
que veux tu dire par la?

La variable "modif" doit être déclarée avant la première sub de la feuille "Thisworkbook"
Cliquez pour agrandir...
je seche ..

merci tous de meme

@+
 
Vote positif 0 Vote négatif
KEUDJ

KEUDJ

XLDnaute Junior
Re : enregistrer classeur si modif

re bonjour Kjin, le forum,

j`ai essaye ton fichier mais chez moi ca plante, bizarre .. j`essaie ce soir sur mon pc perso.

sinon j`ai essaye ton code avec mon fichier mais le comportement souhaite ne fonctionne pas,
par contre tu m`as ouvert les yeux sur certaines voies de sauvegarde que je n`avais pas pris en compte ...

je reflechit et @ suivre,

merci de ton aide ..

A+
 

Pièces jointes

  • test_07-08-2008_153045.zip
    19.6 KB · Affichages: 17
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : enregistrer classeur si modif

Re,
Nouvelle mouture testée à adapter
J'ai nommé les feuilles pour y voir plus clair
Dim Modif As Boolean

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Sheets("Travail1").Visible = True
Sheets("Travail2").Visible = True
Sheets("Accueil").Visible = False
Application.ScreenUpdating = True
Modif = False
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Modif = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Nom As String
Application.ScreenUpdating = False
user = Environ("username")
Nom = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmmss") & ".xls"
If Modif = True Then
Set NewSheet = Worksheets.Add
NewSheet.Name = "Status"
NewSheet.Visible = xlVeryHidden
NewSheet.Range("A1").Value = "Modified by: " & user & " on " & Format(Date, "dddd dd mmmm") & " at " & Format(Now, "hh:mm")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & Nom
End If
Sheets("Accueil").Visible = True
Sheets("Travail1").Visible = xlVeryHidden
Sheets("Travail2").Visible = xlVeryHidden
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
Cliquez pour agrandir...
A+
kjin
 

Pièces jointes

  • Test_V2.zip
    9.6 KB · Affichages: 22
  • Test_V2.zip
    9.6 KB · Affichages: 19
  • Test_V2.zip
    9.6 KB · Affichages: 23
Vote positif 0 Vote négatif
KEUDJ

KEUDJ

XLDnaute Junior
Re : enregistrer classeur si modif

Bonjour Kjin, Le forum

merci pour ton aide, grace a toi j`ai reussi a faire ce que je souhaitais,... en mieux :)

tu verras dans le code j`ai ajouter qqs lignes pour empecher la sauvegarde
il y a peut-etre plus simple?

pour mettre une cerise sur le gateau, serai-t-il possible de deplacer le fichier -1 (dans le cas d`une modif) vers un repertoire archive en auto?

j`ai trouve un post sur le sujet mais je ne pige pas tout:
https://www.excel-downloads.com/threads/deplacer-des-fichiers-vers-un-repertoire.99861/

-->ok j`ai reussi en ajoutant

Code: 
[COLOR="Red"]Chemin = ThisWorkbook.Path
Monfichier = ThisWorkbook.Name[/COLOR]
user = Environ("username")
nom = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 22) & "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hhmmss") & ".xls"
    If Modif = True Then
        Sheets("status").Range("A1").Value = " Modified by: " & user & " on " & Format(Date, "dddd dd mmmm") & " at " & Format(Now, "hh:mm")
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & nom
        [COLOR="red"]Name Chemin & "\" & Monfichier As Chemin & "\archive\" & Monfichier[/COLOR]    
End If

merci & @+
 

Pièces jointes

  • test4_08-08-2008_111259.zip
    20.7 KB · Affichages: 22
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

Chaton0408
  • Question
Microsoft 365 VBA Création Question liste destinataire
Réponses
6
Affichages
179
youky(BJ)
youky(BJ)
P
  • Question
Microsoft 365 Désactivation/activation Application.CommandBars("ply").Enabled
Réponses
6
Affichages
275
pat66
P
patricktoulon
  • Question
Autres Petite mise a jour (exceptionnellement pour cp4) du calendar V4.1(OLDVERSION)
2
Réponses
21
Affichages
587
patricktoulon
patricktoulon
B
  • Question
XL 2016 RESOLU _ Reset le minuteur si Userform Actif et activité sur Userform
Réponses
14
Affichages
375
Dranreb
Dranreb
D
  • Question
Microsoft 365 Historique des modifications
Réponses
11
Affichages
603
sylvanu
sylvanu
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
401
un internaute
U
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
391
M@xu3L
M
M
  • Question
XL 2016 Insertion une date (JJ/MM/AAAA) et la time (HH:MM) dans une ListBox
Réponses
10
Affichages
374
MOEZ-TUN
M
A
  • Question
Microsoft 365 Slicer - supprimer le menu contextuel ou la possibilité de supprimer le filtre
Réponses
1
Affichages
378
xUpsilon
xUpsilon
P
  • Question
Microsoft 365 Fermer classeur avec plusieurs conditions
Réponses
3
Affichages
368
pat66
P

Membres actuellement en ligne

10 membres et 120 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 500
Messages
2 089 004
Membres
104 003
dernier inscrit
adyady__