Sub Macro1() 'Déclaration des variables Dim xlApp As Excel.Application Dim xlWb As Excel.Workbook Dim xlSh As Excel.Worksheet Dim CheminFichier As String Dim iR As Integer Dim i As Integer Dim j As Integer Dim NomSalarie As String Dim PrenomSalarie As String Dim MatriculeCourant As Integer Dim MatriculeSuivant As Integer Dim DocName As String Dim LettrePubli As Document On Error GoTo GestErr 'Affectation des données aux variables Set xlApp = New Excel.Application Set xlWb = xlApp.Workbooks.Open("C:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Fichier_source.xls") 'il faudrait qu'une fenêtre parcourir permette de choisir ce fichier Set xlSh = xlWb.Worksheets(1) Set LettrePubli = Documents.Add("C:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Modele_lettre.doc") 'il faudrait que je puisse trouver le chemin de ce fichier automatiquement (car sera à différents endroits selon les utilisateurs) NomSalarie = "" PrenomSalarie = "" MatriculeCourant = 0 MatriculeSuivant = 0 DocName = "" 'Récupération du nombre de lignes du fichier xls : iR = xlSh.UsedRange.Rows.Count 'Phase de récupération des données de la feuille pour les injecter dans le document : For i = 2 To iR If MatriculeCourant = 0 Then 'Enregistrement du matricule courant: MatriculeCourant = xlSh.Cells(i, 1) 'On rempli les signets avec les infos nécessaire : 'Enregistrement du nom du salarié : NomSalarie = xlSh.Cells(i, 2) LettrePubli.Bookmarks("Nom").Range.Text = NomSalarie 'Enregistrement du prénom du salarié : PrenomSalarie = xlSh.Cells(i, 3) 'Enregistrement du prénom du salarié : PrenomSalarie = xlSh.Cells(i, 3) LettrePubli.Bookmarks("Prénom").Range.Text = PrenomSalarie LettrePubli.Bookmarks("N1").Range.Text = xlSh.Cells(i, 4) LettrePubli.Bookmarks("DIF").Range.Text = xlSh.Cells(i, 6) LettrePubli.Bookmarks("IntituléFormation").Range.Text = xlSh.Cells(i, 18) 'On crée un nom de fichier à son nom : DocName = NomSalarie & "-" & PrenomSalarie & "-" & MatriculeCourant & "-" & Format(Date, "yyyy") 'Si le salarié actuel est différent du suivant : ElseIf MatriculeCourant <> MatriculeSuivant Then 'Enregistrement du fichier du salarié actuel : With LettrePubli .SaveAs "c:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Publipostage" & DocName & ".doc" '.MailMerge.Destination = wdSendToPrinter .Close End With 'Création d'un fichier vierge: Set LettrePubli = Documents.Add("C:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Modele_lettre.doc") MatriculeCourant = MatriculeSuivant 'On rempli les signets avec les infos nécessaire : 'Enregistrement du nom du salarié : NomSalarie = xlSh.Cells(i, 2) 'le nb 2 correspond à la colonne 2 du fichier xls LettrePubli.Bookmarks("Nom").Range.Text = NomSalarie 'Enregistrement du prénom du salarié : PrenomSalarie = xlSh.Cells(i, 3) 'Enregistrement du prénom du salarié : PrenomSalarie = xlSh.Cells(i, 3) LettrePubli.Bookmarks("Prénom").Range.Text = PrenomSalarie LettrePubli.Bookmarks("N1").Range.Text = xlSh.Cells(i, 4) LettrePubli.Bookmarks("DIF").Range.Text = xlSh.Cells(i, 6) LettrePubli.Bookmarks("IntituléFormation").Range.Text = xlSh.Cells(i, 18) 'On crée un nom de fichier à son nom : DocName = NomSalarie & "-" & PrenomSalarie & "-" & MatriculeCourant & "-" & Format(Date, "yyyy") 'Sinon si les matricules sont identiques on rajoute la formation à la liste existante dans la même lettre : Else LettrePubli.Bookmarks("IntituléFormation").Range.Text = xlSh.Cells(i, 18) + Chr(13) End If MatriculeSuivant = xlSh.Cells(i + 1, 1) Next i 'On crée un nom de fichier à son nom : DocName = NomSalarie & "-" & PrenomSalarie & "-" & MatriculeCourant & "-" & Format(Date, "yyyy") 'On enregistre et ferme la dernière lettre publipostée : With LettrePubli .SaveAs "c:\Documents and Settings\Mon_ordi\Mes documents\Mon_dossier\Publipostage" & DocName & ".doc" .Close End With 'Impression de la lettre publipostée : 'ActiveDocument.MailMerge.Destination = wdSendToPrinter Set LettrePubli = Nothing GestErr: 'Si pas de document ouvert on fait un resume next If Err.Number = 91 Then Resume Next Debug.Print "Erreur : " & Err.Number & Err.Description xlWb.Close xlApp.Quit Set xlSh = Nothing Set xlWb = Nothing Set xlApp = Nothing MsgBox ("Publipostage terminé !") End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionCheminFichier = Application.GetOpenFilename("Fichier excel, *.xls", , , , True) 'Génère un message d'erreur : Erreur de compilation... Set xlWb = CheminFichier Set xlSh = xlWb.Worksheets(1) ModeleLettre = ThisDocument.path 'ne donne pas le "vrai" chemin du doc Set LettrePubli = Documents.Add(ModeleLettre)