bouclesdor
XLDnaute Occasionnel
Bonjour cher membre du forum,
J'ai trouvé un code VBA et je tente de l'adapter à mon fichier (j'y ai passé plusieurs heures à comprendre et adapter le code) et j'ai beaucoup de difficulté mais selon moi il y a surement un pro de VBA qui pourra trouver rapidement mon erreur.
voici mes 3 codes:
Option Explicit
-----------------------------------------------------------------
Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim FileName As String
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more then one sheet selected," & vbNewLine & _
"ungroup the sheets and try the macro again"
Else
'Call the function with the correct arguments
'For a fixed range use this line
FileName = RDB_Create_PDF(Range("A1😱60"), "", True, False)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "info@test.com", "Nouveau PO à signer", _
"Bonjour ," _
& vbNewLine & vbNewLine & "voici en pièce jointe le fichier PDF d'un nouveau PO à signer." _
& vbNewLine & vbNewLine & "Merci," _
& vbNewLine & vbNewLine & " bouclesdor", 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
End If
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
'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
Fname = "C:\Documents and Settings\secretariat\Desktop\PO Copie à envoyer fournisseur\" & Range("K8") & " " & Range("a8")
FileFormatstr = "PDF Files (*.pdf), *.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
'-----------------------------------------------------------------
mon code à pour but de créer un fichier PDF et de joindre ce fichier à un courriel mais je veux aussi que le fichier PDF soit copier sur mon desktop. le code roule bien et mon fichier PDF s'enregistre bien sur mon desktop mais le courriel n'est pas créé avec la pièce jointe mais je vois plutot le code d'erreur. je pense que le problème est dans mon code nommé RDB_Selection_Range_To_PDF_And_Create_Mail car au lieu de voir le e-mail ce créer c'est le else avec le code msgbox d'erreur que je vois...
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "info@test.com", "Nouveau PO à signer", _
"Bonjour ," _
& vbNewLine & vbNewLine & "voici en pièce jointe le fichier PDF d'un nouveau PO à signer." _
& vbNewLine & vbNewLine & "Merci," _
& vbNewLine & vbNewLine & " bouclesdor", 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"
Merci de votre aide et je vous souhaite bonne journée,
Bouclesdor
J'ai trouvé un code VBA et je tente de l'adapter à mon fichier (j'y ai passé plusieurs heures à comprendre et adapter le code) et j'ai beaucoup de difficulté mais selon moi il y a surement un pro de VBA qui pourra trouver rapidement mon erreur.
voici mes 3 codes:
Option Explicit
-----------------------------------------------------------------
Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim FileName As String
If ActiveWindow.SelectedSheets.Count > 1 Then
MsgBox "There is more then one sheet selected," & vbNewLine & _
"ungroup the sheets and try the macro again"
Else
'Call the function with the correct arguments
'For a fixed range use this line
FileName = RDB_Create_PDF(Range("A1😱60"), "", True, False)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "info@test.com", "Nouveau PO à signer", _
"Bonjour ," _
& vbNewLine & vbNewLine & "voici en pièce jointe le fichier PDF d'un nouveau PO à signer." _
& vbNewLine & vbNewLine & "Merci," _
& vbNewLine & vbNewLine & " bouclesdor", 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
End If
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
'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
Fname = "C:\Documents and Settings\secretariat\Desktop\PO Copie à envoyer fournisseur\" & Range("K8") & " " & Range("a8")
FileFormatstr = "PDF Files (*.pdf), *.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
'-----------------------------------------------------------------
mon code à pour but de créer un fichier PDF et de joindre ce fichier à un courriel mais je veux aussi que le fichier PDF soit copier sur mon desktop. le code roule bien et mon fichier PDF s'enregistre bien sur mon desktop mais le courriel n'est pas créé avec la pièce jointe mais je vois plutot le code d'erreur. je pense que le problème est dans mon code nommé RDB_Selection_Range_To_PDF_And_Create_Mail car au lieu de voir le e-mail ce créer c'est le else avec le code msgbox d'erreur que je vois...
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "info@test.com", "Nouveau PO à signer", _
"Bonjour ," _
& vbNewLine & vbNewLine & "voici en pièce jointe le fichier PDF d'un nouveau PO à signer." _
& vbNewLine & vbNewLine & "Merci," _
& vbNewLine & vbNewLine & " bouclesdor", 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"
Merci de votre aide et je vous souhaite bonne journée,
Bouclesdor
Dernière édition: