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
| Dim j As Integer
j = ActiveSheet.UsedRange.Rows.Count 'Compter le nombre des lignes
For j = 2 To j
Dim n As Byte
n = Cells(1, Columns.Count).End(xlToLeft).Column
Dim nom As String
nom = Sheets(1).Cells(j, 2)
Set WordApp = CreateObject("word.application")
If ActiveWorkbook.Name Like "Class*.xls" Then ' Condition selon les noms des fichiers excel
Set WordDoc = WordApp.Documents.Open("C:\Documents and Settings\User\My Documents\Class_fich.doc") 'ouvre document Word
Set oWdApp = CreateObject("Word.Application")
Set WordDoc = oWdApp.Documents.Open("C:\Documents and Settings\User\My Documents\Class_fich.doc")
For i = 1 To n
WordDoc.Bookmarks("Sig" & i).Range.Text = Cells(j, i) ' les signets du document Word sont nommés Sig1 , Sig2 , Sig3 ...
Next i
WordDoc.Bookmarks("Signet").Range.Text = Cells(j, 2) 'l entete du fichier WORD ou le nom du formulaire est attribuée a "Signet"
WordDoc.SaveAs Filename:=nom & ".doc" ' enregistre le nouveau doc word selon le nom de la 2 eme colonne du fichier excel
WordApp.Visible = False
End If
Next j |
Partager