Discussion :

[flomos]

Bonjour tout le monde,

Grâce à votre aide, j'ai réussi à réaliser un publipostage au sein d'un même fichier Excel.
Je reviens vers vous pour faire évoluer cette (simple) macro.
Ma macro actuel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
'Boucle de publipostage'
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Sheets("Modele").Copy Before:=Sheets("Feuil3")
ActiveSheet.Name = ("N°" & Sheets("BdD").Range("D" & i))
Range("B3") = Sheets("BdD").Cells(i, 1)
Range("B4") = Sheets("BdD").Cells(i, 2)
Range("B5") = Sheets("BdD").Cells(i, 3)
Range("C2") = Sheets("BdD").Cells(i, 4)
Range("B6") = Sheets("BdD").Cells(i, 5)
Range("B7") = Sheets("BdD").Cells(i, 6)
 
Next i

Résultat obtenu :


Je souhaite maintenant que ma macro intègre la gestion des photos. Pour chaque feuille, j'ai une photo nommé "N"& Sheets("BdD").Range("D" & i) dans un dossier spécifique.
J'aimerais donc qu'au lancement de la macro, celle ci me demande l'emplacement du dossier regroupant les images, puis qu'elle les insère dans chaque feuille.
J'ai trouvé sur internet, le script suivant. Le problème de ce script, c'est qu'il est nécessaire de stipuler, pour chaque image, le chemin exacte en la sélectionnant.

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
Public Sub insere_image()
Dim ficimg As Variant
    ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")  ' choix nom du fichier
    ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
    With Selection.ShapeRange
        .LockAspectRatio = False        ' proportions d'origine lorsque vous la redimensionnez
        .Top = ActiveCell.Top           ' haut de la cellule
        .Left = ActiveCell.Left         ' gauche de la cellule
        .Height = ActiveCell.RowHeight  ' hauteur de la cellule
        .Width = ActiveCell.Width ' largeur de la cellule
    End With
    With Selection
        .PrintObject = True             ' l'objet est imprimé en même temps que le document
        .Placement = xlMoveAndSize      ' manière dont l'objet est lié aux cellules
    End With
End Sub

Je suppose que la solution est dans première ligne mais je ne sais pas comment m'y prendre...

Merci par avance