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