Piece jointe en tant que pdf mail office outlook
f
bonjour à tous!!
Voila mon petit problème je recherche une macro qui pourrait a partir d'une page Excel 2010
la poster en tant que pièce jointe dans la messagerie d'office out look.
Dans l'exemple joint c'est a peut prés ce que je souhaiterais mais la pièce jointe reste au format
excel et non PDF.
Par ailleurs si la fonction pouvait remplir l'objet et un peu de corps de message en faisant
référence a une cellule par exemple ce serait l’idéal.
Dans tout les cas merci a ceux qui réfléchirons
f
Bon je "m'autorépond"
eu égard au peu de réponse je crois que le sujet est bien plus difficile que celui que j'avais imaginé
merci encore a tout ceux qui ont pris le temps de regarder le fichier
R
Bonjour,
Ci-joint 3 fonctions que j'ai créée et que j'utilise pour l'envoie de fichier joint, je pense que ce peut têtre utile.
Bien à toi,
Public Sub Enr_PDF(Répertoire As String, Fichier As String)
' enregistre au format PDF dans le répertoire reçu et avec le nom de fichier reçu
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Répertoire & "\" & Fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Sub Enr_XLSX(Répertoire As String, Fichier As String, Tab_feuilles() As Variant)
' enregistre au format XLSX dans le répertoire reçu et avec le nom de fichier reçu, les feuilles sélectionnées
Dim NouveauClasseur As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Tab_feuilles).Copy
Set NouveauClasseur = ActiveWorkbook
NouveauClasseur.Colors = ThisWorkbook.Colors
NouveauClasseur.SaveAs Répertoire & Fichier
NouveauClasseur.Close
End Sub
Sub Envoi_mail(C As Integer, N_Zone As Variant, D_retour As String, Tab_ZC() As Variant, Répertoire As String, Fichier As String)
Dim Cpt As Integer
Dim Destinataire, Destinataire_CC As String
Dim Corps_Texte As String
Dim Signature As String
Dim SigString As String
Dim Num_perso As Long
Num_perso = Application.UserName
' Dim app_Outlook As Outlook.Application
Set app_Outlook = CreateObject("Outlook.Application")
If app_Outlook.Explorers.Count > 0 Then ' Test si outlook est ouvert; si ce n'est pas le cas, il l'ouvre
'Ok outlook ouvert
Else
'mettre le bon chemin outlook
app_Outlook = Shell("C:\Program Files (x86)\Microsoft Office\Office12\OUTLOOK.exe", vbNormalNoFocus)
End If
'Dim Message As Outlook.MailITEM
Set Message = app_Outlook.CreateItem(olMailItem)
Destinataire = Tab_ZC(C, 2)
Destinataire_CC = Tab_ZC(C, 3)
Sujet = "Suivi VLT - " & N_Zone & " - demande dates d'intervention"
Corps_Texte = "Bonjour,<BR><BR>........ici, ton texte......................".<BR><BR>Bien à vous,<BR><BR><BR>"
' Corps_Texte = "Bonjour,<BR><BR>Ci-joint, vous trouverez ......<BR><BR>"
SigString = Environ("C:\Users\" & Num_perso & "\AppData\Roaming\Microsoft\Signatures\") & Signature
If Dir(SigString) = "" Then
Signature = ""
Else
Signature = Worksheets("INFO").Range("A39").Value
Signature = Signature & ".htm"
End If
On Error Resume Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
With Message
.To = Destinataire
.cc = Destinataire_CC
.bcc = ""
.Subject = Sujet
.BodyFormat = olFormatHTML
.HTMLBODY = Corps_Texte ' & GetBoiler("C:\Users\" & Num_Ulyss & "\AppData\Roaming\Microsoft\Signatures\") & Signature
.Attachments.Add Répertoire & "\" & Fichier
'.display True
.display False
.Send
End With
On Error GoTo 0
'app_Outlook.Quit 'ferme outlook
Set Message = Nothing
Set app_Outlook = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Subbonjour
une porposition
fred
Edit j'ai encore compris a l'envers ci dessous la bonne proposition
c'est une question récurrente voir
Sub mail()
'Fonctionne sous excel 2000-2013
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
Dim S As Shape
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copie la feuille active comme nouvelle feuille
ActiveSheet.Copy
Set destwb = ActiveWorkbook
'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
'----------------------------------------------------------------------------
TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
On Error Resume Next
With OutMail
.To = "fred@toto.fr"
.CC = "Moi@toto.fr"
.bcc = ""
.Subject = "sujet du mail"
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour, le message a mettre dans le mail "
'.display 'ou alors utiliser
.Send 'pour envoi
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Subf
ok Merci beaucoup les gars
Je vais essayer et vous dit quoi
merci encore dans tout les cas