Enregistrement programmé d'un classeur à chaque fin de mois

Résolu/Fermé

robbybasch Messages postés 100 Date d'inscription lundi 14 juillet 2014 Statut Membre Dernière intervention 19 août 2022 - 17 juil. 2017 à 17:49
robbybasch Messages postés 100 Date d'inscription lundi 14 juillet 2014 Statut Membre Dernière intervention 19 août 2022 - 18 juil. 2017 à 17:33

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

A voir également:

Enregistrement programmé d'un classeur à chaque fin de mois
Programme demarrage windows 10 - Guide
Fichier ouvert dans un autre programme - Guide
Desinstaller un programme - Guide
Programme démarrage windows 10 - Guide
Ce message d'erreur apparaît sur l'ordinateur d'elena. que peut-on dire du programme gwxux ? - Forum logiciel systeme

3 réponses

Réponse 1 / 3

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 18 juil. 2017 à 11:36

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

robbybasch Messages postés 100 Date d'inscription lundi 14 juillet 2014 Statut Membre Dernière intervention 19 août 2022
18 juil. 2017 à 14:20

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

Réponse 2 / 3

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
18 juil. 2017 à 14:45

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à

robbybasch Messages postés 100 Date d'inscription lundi 14 juillet 2014 Statut Membre Dernière intervention 19 août 2022
18 juil. 2017 à 15:41

Trop fort. J'avais beau chercher, et trouver quelques items par ici et par là, mais que vois je .. la précision même de M. cs_Le Pivert..
Grand merci à toi.
J'aurai pu y passer la journée.
CDL
Robby

robbybasch Messages postés 100 Date d'inscription lundi 14 juillet 2014 Statut Membre Dernière intervention 19 août 2022
Modifié le 18 juil. 2017 à 16:13

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

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728 > robbybasch Messages postés 100 Date d'inscription lundi 14 juillet 2014 Statut Membre Dernière intervention 19 août 2022
Modifié le 18 juil. 2017 à 16:44

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

Réponse 3 / 3

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
18 juil. 2017 à 16:45

En mettant ceci, voir ci-dessus

On Error Resume Next

robbybasch Messages postés 100 Date d'inscription lundi 14 juillet 2014 Statut Membre Dernière intervention 19 août 2022
18 juil. 2017 à 17:33

Génial..
Merci encore une fois.
La macro est terminée..
CDL
robby

Discussions similaires

programme qui n'affiche pas le mot secret

fin du film chambre 1408

Formule Excel pour afficher les mois (chiffres) en lettre

Pourquoi Program files (x86) et Programmes?

TV LG affiche le carré non programmé

Discussions similaires

Newsletters