Bonjour,
Je bloque sur deux problèmes depuis plusieurs jours, et je m'en remets à vous pour avoir quelque idée.
J'ai un fichier excel avec une macro qui suivant un template word, permet de remplacer des données ciblé dans word par les données excel.
1 - Mon premier problème étant que la macro ne prend en compte que la première ligne du tableau et que je voudrais qu'a chaque ligne de tableau trouvé, une nouvelle page word est générée en prennant en compte le template de la première page.
2 - Et mon autre problème est d'y insérer une image suivant un lien inscrit dans le tableau excel, un peu comme le texte, soit remplacer une cible dans word par l'image.
Je vous join le fichier en question pour plus de précision
Et voici le code de base:
En vous remerciant d'avance pour votre aide,
Cdlt,
Bruno
Je bloque sur deux problèmes depuis plusieurs jours, et je m'en remets à vous pour avoir quelque idée.
J'ai un fichier excel avec une macro qui suivant un template word, permet de remplacer des données ciblé dans word par les données excel.
1 - Mon premier problème étant que la macro ne prend en compte que la première ligne du tableau et que je voudrais qu'a chaque ligne de tableau trouvé, une nouvelle page word est générée en prennant en compte le template de la première page.
2 - Et mon autre problème est d'y insérer une image suivant un lien inscrit dans le tableau excel, un peu comme le texte, soit remplacer une cible dans word par l'image.
Je vous join le fichier en question pour plus de précision
Et voici le code de base:
Code:
Option Explicit
Dim WS_Gen As Worksheet
Dim NOM, PRENOM, ADRESSE, TEL, VILLE
Dim objWord As Word.Application
Dim docWord As Word.Document
Dim docWordF As Word.Document
Sub Commandok_Click()
Dim f As Range
Dim objWord As Word.Application
Dim docWord As Word.Document
Dim docWordF As Word.Document
Set objWord = Nothing
Set docWord = Nothing
NOM = Sheets("Liste").Cells(2, 1).Value
PRENOM = Sheets("Liste").Cells(2, 2).Value
ADRESSE = Sheets("Liste").Cells(2, 3).Value
TEL = Sheets("Liste").Cells(2, 4).Value
VILLE = Sheets("Liste").Cells(2, 5).Value
Dim Fichier As String
Set objWord = CreateObject("Word.Application")
Set docWord = objWord.Documents.Open(ThisWorkbook.Path & "\Liste.doc")
objWord.Visible = True
objWord.Selection.Find.ClearFormatting
With objWord.Selection.Find
.Text = "-NOM-"
.Replacement.Text = NOM
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
objWord.Selection.Find.Execute
objWord.Selection.Find.Execute Replace:=wdReplaceAll
objWord.Selection.Find.ClearFormatting
With objWord.Selection.Find
.Text = "-PRENOM-"
.Replacement.Text = PRENOM
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
objWord.Selection.Find.Execute
objWord.Selection.Find.Execute Replace:=wdReplaceAll
objWord.Selection.Find.ClearFormatting
With objWord.Selection.Find
.Text = "-ADRESSE-"
.Replacement.Text = ADRESSE
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
objWord.Selection.Find.Execute
objWord.Selection.Find.Execute Replace:=wdReplaceAll
objWord.Selection.Find.ClearFormatting
With objWord.Selection.Find
.Text = "-TEL-"
.Replacement.Text = TEL
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
objWord.Selection.Find.Execute
objWord.Selection.Find.Execute Replace:=wdReplaceAll
objWord.Selection.Find.ClearFormatting
With objWord.Selection.Find
.Text = "-VILLE-"
.Replacement.Text = VILLE
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
objWord.Selection.Find.Execute
objWord.Selection.Find.Execute Replace:=wdReplaceAll
objWord.ChangeFileOpenDirectory "C:\" 'Remplacer par l'URL où est le fichier word
objWord.ActiveDocument.SaveAs Filename:=Sheets("Liste").Cells(2, 1).Values
objWord.FileDialog(msoFileDialogSaveAs).Execute
objWord.FileDialog(msoFileDialogSaveAs).Execute
Unload Me
End Sub
En vous remerciant d'avance pour votre aide,
Cdlt,
Bruno