Sub Creation_doc_mois()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Dim NewDoc As Document
1 année = InputBox("Saisir l'année sous la forme aaaa", "MOI")
If année = "" Then Exit Sub
If Not année Like "####" Then
MsgBox ("Saisir sous la forme aaaa")
GoTo 1
End If
2 mois = InputBox("Saisir le mois à créer sous la forme mm")
If mois = "" Then Exit Sub
If Not mois Like "##" Then
MsgBox ("Saisir sous la forme mm")
GoTo 2
End If
Jours = DateAdd("m", 1, DateSerial(année, mois, 1)) - DateSerial(année, mois, 1)
Deb = Timer:
For i = 1 To Jours
Set NewDoc = Application.Documents.Open(ActiveDocument.Path & "\Bulletin.doc")
With NewDoc
.Bookmarks("date_jour").Range.Text = Format(DateSerial(année, mois, i), "dd/mm/yyyy")
.Bookmarks("date_lendemain").Range.Text = Format(DateSerial(année, mois, i + 1), "dd/mm/yyyy")
.Bookmarks("année_cours").Range.Text = Format(DateSerial(année, mois, i), "yyyy")
.Bookmarks("année_prec").Range.Text = Format(DateSerial(année - 1, mois, i), "yyyy")
.Bookmarks("année_prec2").Range.Text = Format(DateSerial(année - 1, mois, i), "yyyy")
.Bookmarks("mois_cours").Range.Text = Format(DateSerial(année, mois, i), "mmmm")
.Bookmarks("mois_cours2").Range.Text = Format(DateSerial(année, mois, i), "mmmm")
.SaveAs FileName:=ThisDocument.Path & "\" & Format(DateSerial(année, mois, i), "yymmdd") & "_modèle_" & Format(DateSerial(année, mois, i), "ddmmyyyy") & ".doc", _
FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False
.Close
End With
Cpt = Cpt + 1
Next i
Application.ScreenUpdating = True: Application.DisplayAlerts = True
MsgBox "Traitement Terminé" & vbLf & _
Cpt & " BRQ créés" & vbLf & _
"en " & Format(Timer - Deb, "0.00") & " Secondes"
End Sub
Private Sub CommandButton1_Click()
Call Creation_doc_mois
End Sub