Dim wd As Object, i As Byte
On Error Resume Next
Set wd = GetObject(, "Word.Application") 'si Word est déjà ouvert
On Error GoTo 0
If wd Is Nothing Then Set wd = CreateObject("Word.Application")
wd.Visible = True
Dc = wd.Documents.Add(ThisWorkbook.Path & "\Rapport.docx")
'Set Plg = Dc.Range
With Dc
' Titre1 premier titre en haut de la page, centré verticalement, gras, 14pt et souligné
' Texte = "Rapport mensuel d'activités"
With .Bookmarks("Titre1").Range
.Text = Texte
With Font
.Size = 14
.Bold = True
.Underline = wdUnderlineSingle
End With
.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
Sheets("1").[T1:U3].Copy
.Bookmarks("Titre2").Range.Paste
With .Bookmarks("Titre2").Range.Find
For i = 1 To 12
.Replacement.ClearFormatting
.Text = Format("1/" & i, "mmmm")
.Replacement.Text = Application.Proper(Format("1/" & i, "mmmm"))
.Execute Replace:=2 '2 => wdReplaceAll
Next
End With
End With
Application.CutCopyMode = 0