Sub proWord_II()
'Déclarations Variables
Dim fd As Worksheet, Limite As Long, Nomdufichier As String
Dim oWdApp As Word.Application 'Pensez à activer la référence à Word -> Outils/Références
Dim oWdDoc As Word.Document
Set fd = Worksheets("feuil1")
'La zone excel débute en A1 e termine en Hi, i étant variable suivant le nombre de ligne du devis
fd.Select
Limite = fd.Range("A65535").End(xlUp).Row 'détermine la dernière ligne de mon tableau
Nomdufichier = InputBox("Nom du fichier", "feuil1")
'Lancer une instance Word
Set oWdApp = CreateObject("Word.Application")
'Rendre Word visible
oWdApp.Visible = True
'Ouvrir un nouveau document
Set oWdDoc = oWdApp.Documents.Add
Sheets("feuil1").Range("B3:H" & Limite + 43).Copy 'selection du tableau
oWdApp.Documents.Add
oWdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
Placement:=wdInLine, DisplayAsIcon:=False
'macroword remplacer
oWdApp.Selection.WholeStory
oWdApp.Selection.Find.ClearFormatting
oWdApp.Selection.Find.Replacement.ClearFormatting
With oWdApp.Selection.Find
.Text = "/"
.Replacement.Text = "^l"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWdApp.Selection.Find.Execute Replace:=wdReplaceAll
oWdApp.Selection.Find.ClearFormatting
oWdApp.Selection.Find.Replacement.ClearFormatting
With oWdApp.Selection.Find
.Text = "^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWdApp.Selection.Find.Execute Replace:=wdReplaceAll
oWdApp.Selection.Find.ClearFormatting
oWdApp.Selection.Find.Replacement.ClearFormatting
With oWdApp.Selection.Find
.Text = "^t"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWdApp.Selection.Find.Execute Replace:=wdReplaceAll
oWdApp.ActiveDocument.SaveAs ThisWorkbook.Path & "/" & Nomdufichier & ".doc"
oWdApp.Quit
Set oWdDoc = Nothing: Set oWdApp = Nothing
End Sub