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 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
| Sub Transfer_To_Word_Dynamic()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i As Byte
For i = 2 To Sheets("Data Owners").Cells(Rows.Count, 1).End(xlUp).Row
Set WordApp = CreateObject("word.application") 'Open a word session
Set WordDoc = WordApp.Documents.Open("Nomdevotrefichier.doc") 'ouvre le document Word
WordApp.Visible = False 'Word is not visible during the operation
'we named the bookmarks in the word doc as followed : Signet1 , Signet2 , Signet3
WordDoc.Bookmarks("Signet1").Range.Text = Sheets("Data Owners").Cells(i, 1)
WordDoc.Bookmarks("Signet2").Range.Text = Sheets("Data Owners").Cells(i, 4)
WordDoc.Bookmarks("Signet3").Range.Text = Sheets("Data Owners").Cells(i, 11)
' Creation de signet automatique dans word a partir de Excel et ajout de ligne automatique dans tableau word
'Fill-in the rest of the signet depending on the values from column 38 to 53
k = 7 ' next signet to create
w = 2 ' next line in table(5) of the word document
For j = 38 To 53
If Sheets("Data Owners").Cells(i, j) <> "" Then
k = k + 1
w = w + 1
WordDoc.Tables(5).Rows.Add
WordDoc.Tables(5).Rows(w).Cells(1).Select
With WordDoc.Bookmarks
.Add Name:="Signet" & k
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
WordDoc.Bookmarks("Signet" & k).Range.Text = Sheets("Data Owners").Cells(i, j)
Else
Exit For
End If
Next
'mettre a jour dynamiquement l'entete et le bas de page de mon document word
WordDoc.Bookmarks("Signet_Footer").Range.Text = "DML640_MOCK3_Validation_" + Sheets("Data Owners").Cells(i, 34) + "_" + Sheets("Data Owners").Cells(i, 35) + "_v1.doc"
WordApp.Visible = True 'Open the word document
'WordDoc.PrintOut 'To print the doc document
WordDoc.SaveAs ("nouveaunomdefichier.doc")' pouvz aussi sauvegarder le meme fichier
WordDoc.Close True 'Save and close the word document
WordApp.Quit 'Open the word session
Next i
End Sub |
Partager