Executer une macro une seule fois par mois

**Ghost0000** · 02/02/2016, 10h29

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

**Menhir** · 02/02/2016, 10h39

A la fin de ta macro, place dans une cellule (pour l'exemple, je choisis A1) le numéro du mois en cours.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A1").Value = Month(Date)

En début de macro, compare la valeur de cette cellule au mois courant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Range("A1").Value = Month(Date) Then Exit Sub

**Ghost0000** · 02/02/2016, 10h47

Merci de ton aide ! Tu veux de je test ce nouveau code à l'aide d'un Bouton ?

Il s'agit d'une fonction en réalité et non d'un SUB

EDIT 9:53 : Lors d'un clic sur le Bouton permettant de lancer la fonction, il ne se passe rien, donc "Exit function" fonctionne.

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
 Public cpt As Integer
 
Function Test_changement_mois()
'Test si la macro a ete execute une fois dans la journee .
If Sheets("MDP").Range("A1").Value = Month(Date) 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
    Sheets("MDP").Range("A1").Value = Month(Date)
End Function

**Menhir** · 02/02/2016, 10h54

Tout ceci est devenu inutile :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Month(Date) <> Month(Date - 1) Then

Tout comme le End If à la fin.

Envoyé par Ghost0000

Il s'agit d'une fonction en réalité et non d'un SUB

A mon avis, c'est une mauvaise idée.
Une fonction est chargée de renvoyer une valeur.
Un Sub est chargé de réaliser une action.

Si tu utilises l'un pour l'autre, parfois ça peut marcher mais tu risques d'avoir souvent des problèmes.

**Ghost0000** · 02/02/2016, 11h01

Le souci c'est que j'ai besoin de faire appel à cette fonction à plusieurs moments au Niveau de mon document (à chaque entrée de données dans le formulaire) et à part une fonction je vois pas comment faire...

Merci encore de ton Aide !!

Voici mon code modifier selon tes préconisations :

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
Function Test_changement_mois()
'Test si la macro a ete execute une fois dans la journee .
If Sheets("MDP").Range("A1000").Value = Month(Date) 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":
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
 
Sheets("MDP").Range("A1000").Value = Month(Date)
End Function

**Menhir** · 02/02/2016, 11h08

Envoyé par Ghost0000

Le souci c'est que j'ai besoin de faire appel à cette fonction à plusieurs moments au Niveau de mon document (à chaque entrée de données dans le formulaire) et à part une fonction je vois pas comment faire...

Etant donné qu'elle ne doit fonctionner qu'une fois par mois, je ne comprends pas trop tes explications.
Il suffirait, me semble-t-il, de la lancer à l'ouverture de fichier avec une macro évènementielle Workbook_Open().

A moins que ce soit un fichier ouvert en permanence et, dans ce cas, ce serait beaucoup plus simple à gérer avec un OnTime.

**Ghost0000** · 02/02/2016, 11h10

Je veux prévoir tous les cas de figures : des personnes pourraient faire tourner ce fichier Excel sans le fermer pendant plusieurs jours... d'où ce choix un peu bizarre... également des Sauvegarde régulière à chaque saisie de données sont réalisés...

**Menhir** · 02/02/2016, 11h26

Remplace le début de ton code par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Workbook_Open()
    If Sheets("MDP").Range("A1000").Value = Month(Date) Then
        Application.OnTime DateSerial(Year(Date),Mounth(Date)+1,1) + (1/24)
        Exit Sub
    End If

Quand le fichier est ouvert, la macro vérifie si elle doit se lancer.
Si ce n'est pas le cas, elle se relancera le 1er du mois à 1h du matin si le fichier est rester ouvert jusque là.

N'oublie pas de changer le End Function par End Sub.

**Ghost0000** · 02/02/2016, 14h54

Merci de ton aide, j'ai fais ça afin de me simplifier la vie...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Workbook_Open()
Test_changement_mois 'J'appel ma fonction ICI
Sheets("Carte").Activate
End Sub

Executer une macro une seule fois par mois [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager