Publipostage spécial

[millaw]

Bonjour à tous,

Je viens vers vous car j'ai un "petit" souci concernant une opération de publipostage.

Voici le problème :
Comme pour tout publipostage, j'ai un tableau avec mes coordonnées de contact et tout. Jusque là je pense ne pas avoir trop de souci pour faire la fusion vers un document word.

Le problème est que j'ai des informations que je souhaite intégrer et qui ne mérite pas d'être dans le tableau, car c'est la même donnée. (et aussi car le fichier excel est amené à être imprimé).

Je vous ai mis mon fichier pour que vous compreniez :
- partie du haut : base pour le publipostage
- partie du bas : exemple les date et tout => données à insérer en plus.

Donc si vous avez une solution. J'ai pensé à une macro avec les signets mais je ne sais pas trop....

Par avance merci ^^

Millaw

 

[millaw]

Re : Publipostage spécial

Même pas une petite idée? 38 vue mais aucun n'a de solution?
j'ai trouvé sur un forum une discussion concernant une sorte de publipostage excel-excel avec copie de contenu de cellule vers une feuille (ci-joint le fichier et le code)
Cependant je ne comprend pas vraiment ce code fonctionne notamment "curcell.offset"

Sub publipostage()
Dim newWst As Worksheet, curCell As Range
Set curCell = ThisWorkbook.Sheets("Feuil1").Range("A2")

'créer une nouvelle feuille
ThisWorkbook.Worksheets("Feuil2").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set newWst = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
'supprimer le bouton de la feuille
newWst.Shapes("Rectangle 1").Delete

'boucle sur les entrées de la Feuil1
While curCell.Value <> vbNullString
    With newWst
        'copier les valeurs
        .Range("C2").Value = curCell.Value
        .Range("C3").Value = curCell.Offset(0, 1).Value
        .Range("C4").Value = curCell.Offset(0, 2).Value
        .Range("D5").Value = curCell.Offset(0, 3).Value
        .Range("D6").Value = curCell.Offset(0, 4).Value
        'impripmer la feuille
        On Error Resume Next
        .PrintOut
        On Error GoTo 0
    End With
    Set curCell = curCell.Offset(1, 0)
Wend

'supprime la nouvelle feuille
Application.DisplayAlerts = False
newWst.Delete
Application.DisplayAlerts = True

End Sub

Si quelqu'un pouvait m'éclaircir.
Par avance merci