joelle2302
XLDnaute Nouveau
Bonjour à tous,
Cela fait plusieurs jours que je cherche une solution à mon problème. La solution est certainement très simple mais je débute en vba et là je suis coincée.
J'ai une offre que nous envoyons au client sur excel. (Nous les faisons sur excel et non sur word car elles changent souvent et de nombreux calculs sont présents.)
J'ai un document avec une liste de contact : Nom, Société, Email, code du client...
J'aimerai créer un publipostage dans excel qui reprendrait mon offre car la même doit partir à tous les clients.
En gros j'ai besoin :
1. que le publipostage se fasse à l'aide de ma liste de contact
2. que le programme enregistre à un endroit précis un document par offre et non pas tout dans un seul document comme Word a tendance à le faire.
3. qu'il imprime les documents
3. Idéalement qu'il enregistre également chaque document en pdf au même endroit
4. et le top du top : qu'il m'ouvre outlook et crée un message par destinataire avec un message personnalisé pour que je puisse faire le dernier controle et envoyer manuellement.
Est-ce que c'est possible ? Pour l'envoi pdf j'utilise déjà un programme ci-dessous quand je fais des offres à l'unité sans publipostage.
Sub ClientOffrePDF_Envoi()
Dim FileName As String
'Call the function with the correct arguments
FileName = RDB_Create_PDF(ActiveWorkbook, "", True, True)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "", "Offre Opale " & Range("C8").Value & " " & Range("C10").Value, _
"Nous avons le plaisir de vous remettre, en annexe, une offre relative au sujet cité sous rubrique." & vbNewLine & " " & vbNewLine & _
"Si notre proposition vous convient, merci de nous la retourner munie de votre accord (par téléphone au no 021.811.55.09)." & vbNewLine & _
"Nous restons, bien entendu, à votre disposition pour toute question que vous jugeriez utile." & vbNewLine & " " & vbNewLine & _
"Meilleures salutations.", False
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
ActiveWorkbook.Close
End Sub
Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant
ActiveWorkbook.Save
ActiveWorkbook.PrintOut
'Test If the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the pdf
FileFormatstr = "PDF Files (*.pdf), *.pdf"
Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF")
'If you cancel this dialog Exit the function
If Fname = False Then Exit Function
Else
Fname = FixedFilePathName
End If
'If OverwriteIfFileExist = False we test if the PDF
'already exist in the folder and Exit the function if that is True
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
'Now the file name is correct we Publish to PDF
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If Publish is Ok the function will return the file name
If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End If
End Function
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
StrSubject As String, StrBody As String, Send As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = StrTo
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Merci beaucoup pour votre aide!!!
Cela fait plusieurs jours que je cherche une solution à mon problème. La solution est certainement très simple mais je débute en vba et là je suis coincée.
J'ai une offre que nous envoyons au client sur excel. (Nous les faisons sur excel et non sur word car elles changent souvent et de nombreux calculs sont présents.)
J'ai un document avec une liste de contact : Nom, Société, Email, code du client...
J'aimerai créer un publipostage dans excel qui reprendrait mon offre car la même doit partir à tous les clients.
En gros j'ai besoin :
1. que le publipostage se fasse à l'aide de ma liste de contact
2. que le programme enregistre à un endroit précis un document par offre et non pas tout dans un seul document comme Word a tendance à le faire.
3. qu'il imprime les documents
3. Idéalement qu'il enregistre également chaque document en pdf au même endroit
4. et le top du top : qu'il m'ouvre outlook et crée un message par destinataire avec un message personnalisé pour que je puisse faire le dernier controle et envoyer manuellement.
Est-ce que c'est possible ? Pour l'envoi pdf j'utilise déjà un programme ci-dessous quand je fais des offres à l'unité sans publipostage.
Sub ClientOffrePDF_Envoi()
Dim FileName As String
'Call the function with the correct arguments
FileName = RDB_Create_PDF(ActiveWorkbook, "", True, True)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "", "Offre Opale " & Range("C8").Value & " " & Range("C10").Value, _
"Nous avons le plaisir de vous remettre, en annexe, une offre relative au sujet cité sous rubrique." & vbNewLine & " " & vbNewLine & _
"Si notre proposition vous convient, merci de nous la retourner munie de votre accord (par téléphone au no 021.811.55.09)." & vbNewLine & _
"Nous restons, bien entendu, à votre disposition pour toute question que vous jugeriez utile." & vbNewLine & " " & vbNewLine & _
"Meilleures salutations.", False
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
ActiveWorkbook.Close
End Sub
Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant
ActiveWorkbook.Save
ActiveWorkbook.PrintOut
'Test If the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the pdf
FileFormatstr = "PDF Files (*.pdf), *.pdf"
Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF")
'If you cancel this dialog Exit the function
If Fname = False Then Exit Function
Else
Fname = FixedFilePathName
End If
'If OverwriteIfFileExist = False we test if the PDF
'already exist in the folder and Exit the function if that is True
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
'Now the file name is correct we Publish to PDF
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If Publish is Ok the function will return the file name
If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End If
End Function
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
StrSubject As String, StrBody As String, Send As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = StrTo
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Merci beaucoup pour votre aide!!!
