Bonjour à tous,

Je souhaiterai executer une macro une seule fois par mois me permettant ensuite d'archiver les données contenu dans mon document.

Le souci, c'est que lorsque j'arrive le 1er du mois, au moment de l'archivage, cela me rééxecute mon code à chaque ouverture, j'aimerai que ça l'execute une seule fois par mois et cela même le 1er du mois.

J'ai essayé quelques trucs Avec un compteur, cela ne fonctionne pas...

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
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
 
Public cpt As Integer
 
Function Test_changement_mois()
'Test si la macro a ete execute une fois dans la journee .
If cpt = 1 Then
        Exit Function
'-----------------------------------------------------------------------------------
'On vérifie s'il nous faut "un formulaire vierge" ou "celui rempli le jour précédent" :
'-----------------------------------------------------------------------------------
 
'On compare le mois du "jour précédent" avec le mois du "jour actuel":
If Month(Date) <> Month(Date - 1) Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
'------------------------------------------------------------------
'                       Enregistrement et classement du
'                     formulaire rempli le mois précédent
'------------------------------------------------------------------
'Enregistrement du fichier du mois :
Dim nom As String
Dim chemin As String
    nom = Month(Date - 1) & "_" & Year(Date) '--> Nom du fichier d'enregistrement contenu dans cellule A1 (Gestion des déchets)
    chemin = "\\filer4\controles_production$\Historique\Gestion des déchets\PDF"    '-->Chemin d'enregistrement en PDF
 
'Suppression de l'onglet "Carte"
For i = 1 To ThisWorkbook.Worksheets.Count
    If ThisWorkbook.Worksheets(i).Name = "Carte" Then
Sheets("Carte").Activate
ActiveSheet.Unprotect "protection"
Sheets("Carte").Delete
    End If
Next i
 
'Traitement des pages (affichage de la barre des onglets et suppressions des boutons de navigations)
Sheets("Densité").Activate
ActiveSheet.Unprotect "protection"
ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
    Selection.Delete
ActiveSheet.Shapes.Range(Array("CommandButton2")).Select
    Selection.Delete
ActiveWindow.DisplayWorkbookTabs = True
 
Sheets("BDD").Activate
ActiveSheet.Unprotect "protection"
ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
    Selection.Delete
ActiveSheet.Shapes.Range(Array("CommandButton2")).Select
    Selection.Delete
ActiveWindow.DisplayWorkbookTabs = True
 
Sheets("Rapport").Activate
ActiveSheet.Unprotect "protection"
ActiveSheet.Shapes.Range(Array("CommandButton1")).Select
    Selection.Delete
ActiveSheet.Shapes.Range(Array("CommandButton2")).Select
    Selection.Delete
ActiveWindow.DisplayWorkbookTabs = True
 
'Enregistrement en xlsx
'ActiveWorkbook.SaveAs Filename:="" & chemin & nom & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
 
'Enregistrement en pdf
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
     Filename:="" & chemin & nom & ".pdf", _
     Quality:=xlQualityStandard, _
     IncludeDocProperties:=True, _
     IgnorePrintAreas:=False, _
     OpenAfterPublish:=False
 
MsgBox "Données du mois précédent sauvegardé dans :" & chemin & nom & ".pdf"
 
'------------------------------------------------------------------
'                        Ouverture du formulaire vierge
'------------------------------------------------------------------
'On ouvre un formulaire vierge :
    Workbooks.Open Filename:= _
        "\\filer4\controles_production$\Formulaires\Gestion des déchets.xlsm"
'On supprime le contenu de la BDD
Sheets("BDD").Range("A3:AP99999").ClearContents
Range("A3").Select
'On revient sur la vue "Carte"
Sheets("Carte").Activate
 
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End If
    End If
    cpt = 1
End Function
Merci d'avance pour votre Aide !!

GK