Option Explicit
' ***********************************************************************
' ***** *****
' ***** CODE PierreP56 : http://tatiak.canalblog.com/ *****
' ***** *****
' ***********************************************************************
Public WordApp As Object, WordDoc As Object
Sub Ouvre_Doc()
Dim lg As Long, ndf As String, T As Variant
lg = ActiveCell.Row
T = ActiveSheet.Range("A" & lg & ":L" & lg).Value
If lg < 16 Or T(1, 1) = "" Then
MsgBox "Vous devez sélectionner une ligne de données"
Exit Sub
End If
ndf = ThisWorkbook.Path & "\Fiche_" & T(1, 1) & "_" & Format(Date, "ddmmyy")
ActiveSheet.OLEObjects(Application.Caller).Verb xlVerbOpen
Set WordApp = GetObject(, "Word.Application")
Set WordDoc = WordApp.ActiveDocument
WordApp.Visible = False
With WordDoc
.Tables(2).cell(1, 2).Range.Text = T(1, 1)
.Tables(2).cell(1, 4).Range.Text = T(1, 4)
' etc ...
.SaveAs2 Filename:=ndf & ".docx"
.Close SaveChanges:=0
End With
WordApp.Application.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
MsgBox "Ok"
End Sub
' *************************************************************************************************