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

Résolu

robbybasch Messages postés 100 Date d'inscription Statut Membre Dernière intervention -
robbybasch Messages postés 100 Date d'inscription Statut Membre Dernière intervention - 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

Afficher la suite

A voir également:

Enregistrement programmé d'un classeur à chaque fin de mois
Fin des zfe - Guide
Programme demarrage windows - Guide
Reconsidérer le traitement de vos informations à des fins publicitaires - Accueil - Réseaux sociaux
Mettre en veille un programme - Guide
Enregistrement mp3 gratuit - Télécharger - Streaming audio

3 réponses

Réponse 1 / 3

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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 Statut Membre Dernière intervention

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 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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 Statut Membre Dernière intervention

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 Statut Membre Dernière intervention

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 7904 Date d'inscription Statut Contributeur Dernière intervention 729 > robbybasch Messages postés 100 Date d'inscription Statut Membre Dernière intervention

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 7904 Date d'inscription Statut Contributeur Dernière intervention 729

En mettant ceci, voir ci-dessus

On Error Resume Next

robbybasch Messages postés 100 Date d'inscription Statut Membre Dernière intervention

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

Discussions similaires

Comment supprimer un contact

fichier excel pour étiquettes

Votre réponse

Discussions similaires