Bonjour à tous,
Je vous explique la situation... j'ai fait un code qui fait un publipostage excel/word grâce à des signets.
Dans ce publipostage le signet "nom" fait apparaitre le nom et prenom de la personne et permet grâce à une vaiable d'ensuite enregistrer le doc word en dur sous le nom de la personne.
J'ai besoin d'y ajouter la photo de la personne, sachant que chaque photo est enregistrer dans le meme dossier sous le nom désigné dans la base excel pour le pupli.
Voici le code du publipostage:
Voici un code trouvé pour inserer une image mais qui ne contient pas la variable souhaité:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Sub Publipostage() Application.ScreenUpdating = False ' Dim oApp As Word.Application, doc As Word.Document Range("E4").Select ' premier client Do While Not IsEmpty(ActiveCell) On Error Resume Next nf = ThisWorkbook.Path & "\fiche-vierge.doc" Set oApp = CreateObject("Word.Application") oApp.Visible = True Set doc = oApp.Documents.Open(nf) If Err <> 0 Then MsgBox "Le fichier fiche.doc doit être dans " & ThisWorkbook.Path Exit Sub End If On Error GoTo 0 ' Annule la gestion d'erreur '-- Nom = ActiveCell.Value I = ActiveCell.Offset(0, 1).Value An = ActiveCell.Offset(0, 8).Value C = ActiveCell.Offset(0, 9).Value Ag = ActiveCell.Offset(0, 4).Value Dg = ActiveCell.Offset(0, 13).Value D = ActiveCell.Offset(0, 14).Value '-- With doc .Bookmarks("nom").Range.Text = Nom .Bookmarks("I").Range.Text = I .Bookmarks("An").Range.Text = An .Bookmarks("C").Range.Text = C .Bookmarks("Ag").Range.Text = Ag .Bookmarks("Dg").Range.Text = Dg .Bookmarks("D").Range.Text = D End With nom_doc = ThisWorkbook.Path & "\" & Nom & ".doc" doc.SaveAs nom_doc oApp.Quit ActiveCell.Offset(1, 0).Select ' Client suivant Loop Set oApp = Nothing MsgBox "Les Fiches sont Créées par agent" End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 Sub Test_Photo() Dim W As Object Set W = CreateObject("Word.application") X = ActiveCell.Value W.Visible = True W.Documents.Open ActiveWorkbook.Path & "\fiche-vierge.doc" W.ActiveDocument.Bookmarks("Nom").Range.Text = Nom W.ActiveDocument.Bookmarks("Photo").Range.Select If Dir(ActiveWorkbook.Path & "\" & Nom & "POLE.JPG") <> "" Then W.Selection.InlineShapes.AddPicture Filename:=ActiveWorkbook.Path & "\" & Nom & "POLE.JPG", LinkToFile:=False, SaveWithDocument:=True End If W.ActiveDocument.SaveAs ActiveWorkbook.Path & "\nom.doc" W.Quit Set W = Nothing End Sub
Merci pour votre aide!!!
Partager