envoi d'un onglet en pdf

[erwanhavre]

Bonjour à tous
Depuis hier je glane les forums et discutions mais je n'arrive pas à adapter de code vba à ma demande et configuration

- je cherche un moyen d'envoyer par mail en pdf l'onglet actif via un bouton.(Outlook 2007)
les adresses mails seront dans les cellules a10 a11 a12
l'objet du mail est en a13
et le corp texte du mail est en a14
- que ce fichier pdf soit enregistré dans le dossier source du classeur

juste avant l'envoi du mail avec la pj est t'il possible de demander une confirmation d'envoi ?

merci à tous !!

 

[kiki29]

Re : envoi d'un onglet en pdf

Salut, regarde ici

 

[erwanhavre]

Re : envoi d'un onglet en pdf

Salut merci beaucoup ça m'a l'air d'etre une mine d'or ce site
j'ai donc opté pour le code ci-dessous par contre il ne m'envoi pas le fichier en pdf
est ce possible ?


Sub Mail_ActiveSheet()
'Working in Excel 2000-2013
'For Tips see: Excel Automation - Ron de Bruin
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With

' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[erwanhavre]

Re : envoi d'un onglet en pdf

j'y suis presque je bidouille lol
voici le code utilisé il ne me reste plus qu'à trouver comment enregistrer le fichier pdf dans le dossier source du classeur avec le nom

'Create a PDF and mail of every sheet with a mail address in cell A1 (Sheet5 and sheet6)
'You see that the code create two mails, one with sheet5 and one with sheet6 and send it
'to the address in A1 of that sheet.

Sub Mail_Every_Worksheet_With_Address_In_A1_PDF()

'Working only in 2007 and up
Dim sh As Worksheet
Dim TempFilePath As String
Dim TempFileName As String
Dim FileName As String
'Temporary path to save the PDF files
'You can also use another folder like
'TempFilePath = "C:\Users\Ron\MyFolder\"
TempFilePath = Environ$("temp") & "\"

'Loop through every worksheet
For Each sh In ThisWorkbook.Worksheets
FileName = ""

'Test A1 for a mail address
If sh.Range("A1").Value Like "?*@?*.?*" Then

'If there is a mail address in A1 create the file name and the PDF
TempFileName = TempFilePath & "BDC n°" & Range("a2").Value & " Groupe " & Format(Now, "dd-mm-yy ") & ".pdf"

FileName = RDB_Create_PDF(Source:=sh, _
FixedFilePathName:=TempFileName, _
OverwriteIfFileExist:=True, _
OpenPDFAfterPublish:=False)

'If publishing is OK create the mail
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
StrTo:=sh.Range("A1").Value, _
StrCC:="", _
StrBCC:="", _
StrSubject:="Bon de commmande ", _
Signature:=True, _
Send:=False, _
StrBody:="<H3><B>Bonjour, </B></H3><br>" & _
"<body>Merci de trouver ci-joint notre bon de commande" & _
"<br><br>" & "Nous attendons votre retour pour confirmation, restant à votre disposition.</body>"
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
Next sh
End Sub

 

[Yaloo]

Re : envoi d'un onglet en pdf

Bonjour erwanhavre, le forum,

Vois avec le complément Microsoft

A+

Martial