Enregistrement programmé d'un classeur à chaque fin de mois
Résolu
robbybasch
Messages postés
101
Statut
Membre
-
robbybasch Messages postés 101 Statut Membre -
robbybasch Messages postés 101 Statut Membre -
Bonjour,
Je voudrais faire un enregistrement programmé de mon planning. A l'ouverture du fichier planning, je voudrais pendant un intervalle donné (par ex 4 jours avant la fin du mois) qu'un boite msg2 s'ouvre et indique à l'utilisateur le message suivant :
"Voulez vous effectuer un enregistrement de fin de mois ?"
si oui macro qui enregistre sous ce nom par ex : 2017_Planning_29_juillet (si le pc est à la date du 29 juillet). L'enregistrement se fera dans le dossier ou se trouve le document de départ. (Peut être à voir en lien relatifs pour éviter tous les désagréments de changement de PC)
si non
je passe au planning.
Passé le 31 juillet à minuit, le message disparait et réapparaitra à partir du 27 aout.
Est ce possible en VBA ?
CDL
Robby
Je voudrais faire un enregistrement programmé de mon planning. A l'ouverture du fichier planning, je voudrais pendant un intervalle donné (par ex 4 jours avant la fin du mois) qu'un boite msg2 s'ouvre et indique à l'utilisateur le message suivant :
"Voulez vous effectuer un enregistrement de fin de mois ?"
si oui macro qui enregistre sous ce nom par ex : 2017_Planning_29_juillet (si le pc est à la date du 29 juillet). L'enregistrement se fera dans le dossier ou se trouve le document de départ. (Peut être à voir en lien relatifs pour éviter tous les désagréments de changement de PC)
si non
je passe au planning.
Passé le 31 juillet à minuit, le message disparait et réapparaitra à partir du 27 aout.
Est ce possible en VBA ?
CDL
Robby
3 réponses
-
Bonjour,
a mettre dans ThisWorkbook:
Option Explicit Dim fin As Date Dim reste As Integer Dim rep As Integer Dim chemin As String Private Sub Workbook_Open() fin = DateSerial(Year(Date), Month(Date) + 1, 1) - 1 'fin de mois reste = fin - Date If reste <= 14 Then 'adapter nbre jours rep = MsgBox("Voulez vous effectuer un enregistrement de fin de mois?", vbYesNo + vbQuestion, "Enregistrement") If rep = vbYes Then chemin = ThisWorkbook.Path & "\2017_Planning.xls" 'adapter extension ActiveWorkbook.SaveAs Filename:= _ chemin, FileFormat:=xlExcel8, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False Else ' ici le traitement si réponse négative ' ... End If Else Exit Sub End If End Sub
@+ Le Pivert-
Bonjour cs_Le Pivert
Super c'est exactement ce que je voulais. Par contre est-il possible de proposer un nom de fichier avec la date du jour du PC, afin que la personne qui va utiliser le fichier, n'ait pas à se soucier du nom.
Ex :
chemin = ThisWorkbook.Path & "\2017_Planning.xlsm "
donnerait "2017_Planning_18_07_2017.xlsm"
Il faudrait ajouter dans une variable "_18_07_2017.xlsm" 'variable qui evoluera avec la date du PC
Merci encore une fois
CDL
Robby
-
-
Comme ceci:
Dim madate As String If rep = vbYes Then madate = Date madate = Replace(madate, "/", "_") chemin = ThisWorkbook.Path & "\2017_Planning_" & madate & ".xls" 'adapter extension
Voilà
-
-
Je viens de m'apercevoir que si le fichier existe déjà et que la personne veut réenregistrer sous le même nom si je réponds au message proposé par excel : OUI à l'enregistrement ca passe, si je réponds NON cela bloque Peut on gérer cet aspect ? je te donne la macro complète :
Option Explicit
Dim fin As Date
Dim reste As Integer
Dim rep As Integer
Dim chemin As String
Dim madate As String
Private Sub Workbook_Open()
fin = DateSerial(Year(Date), Month(Date) + 1, 1) - 1 'fin de mois
reste = fin - Date
If reste <= 14 Then 'adapter nbre jours
rep = MsgBox("Voulez vous effectuer un enregistrement de fin de mois?", vbYesNo + vbQuestion, "Enregistrement")
If rep = vbYes Then
madate = Date
madate = Replace(madate, "/", "_")
chemin = ThisWorkbook.Path & "\2017_Planning_" & madate & ".xlsm"
rep = MsgBox("Le nom du fichier sera : " & chemin, vbYes + vbQuestion, "Enregistrement")
If rep = vbYes Then
End If
'a cet endroit si le nom existe et réenregistrement erreur macro..
ActiveWorkbook.SaveAs Filename:= _
chemin, FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Else
rep = MsgBox("Il faudra penser à faire des enregistrements réguliers de votre planning à des dates différentes afin de créer des sauvegardes récentes", vbYes + vbQuestion, "Enregistrement")
If rep = vbYes Then
End If
End If
Else
Exit Sub
End If
End Sub
Merci si tu trouves une correction. Je pense qu'il faut une condition mais je bloque..
CDL
Robby- comme ceci, tu auras juste l'avertissement d'enregistrement sur le même fichier:
rep = MsgBox("Voulez vous effectuer un enregistrement de fin de mois?", vbYesNo + vbQuestion, "Enregistrement") If rep = vbYes Then madate = Date madate = Replace(madate, "/", "_") chemin = ThisWorkbook.Path & "\2017_Planning_" & madate & ".xlsm" On Error Resume Next ActiveWorkbook.SaveAs Filename:= _ chemin, FileFormat _ :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
@+ Le Pivert
-
-
En mettant ceci, voir ci-dessus
On Error Resume Next
