Macro pour envoyer un PDF issue d un fichier Excel

Le 25/08/2015 à 11:23

Bonjour,

j'ai un fichier excel pour le quel j ai mi un bouton et pour le quel j aimerais attacher une macro.

la macro est la suivante :

en cliquant sur le bouton cela génère une page PDF d un seul onglet celui sur le quel je suis par exemple.

Puis ce même PDF doit être envoyé via Outlook avec une adresse mail puis envoyer et revenir à la page excel.

Est ce possible et si oui Pourriez vous m aider svp. je sais faire des Macros mais pas en programmation.

Un grand merci de votre aide

Le 25/08/2015 à 11:51

bonjour et bienvenu

voici un code que j'ai en stock qui fait ce que tu demande

a adapter au niveau des destinataires /sujet/corps du texte du mail a envoyer

fred

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 Sub

EDIT : je viens de modifier pour faire l'enregistrement au format pdf qui n'étais pas fait (c'était au format excel la piece jointe)

Le 25/08/2015 à 12:23

Excellent, un grand merci ça fonctionne parfaitement bien.

juste j aurai préféré un format PDF dans le mails si possible.

Olivier

Merci fred2406

Le 25/08/2015 à 12:30

Reprend a présent le code dans mon premier post

car je l'avais éditer pour le changer mais visiblement tu l'avais déjà pris...et fait tes essais avec la première version

fred

Le 25/08/2015 à 12:38

Superrrrrrrrrrrrr merci. un très grand merci ça fonctionne à merveille.

Bon après midi

Le 25/08/2015 à 12:41

Dans ce cas

Merci

Fred

Le 01/09/2015 à 10:52

Bonjour,

J'utilise la macro qui fonctionne a merveille seul petit bémol;

la page est trop grande et donc me sort un PDF illisible car trop petit.

ma solution est d imposer l impression des colonnes de A à L par exemple.

Pourriez vous m indiquer ou puis je mettre cela dans la macro et surtout que dois je y mettre.

Merci par avance.

Olivier

Le 01/09/2015 à 21:37

bonsoir

A priori définir la zone d'impression et puis c'est tout....

fred

Le 01/09/2015 à 22:20

Oui j y ai bien pensé mais je veux que cela se fasse dans la macro en automatique.

Comment faire

Merci

Le 02/09/2015 à 00:07

on peu definir la zone d'impression par macro de manière suivante :

Worksheets("Sheet1").PageSetup.PrintArea = "$A$1:$C$5"

a adapter en conséquence et a a mettre avant l'export pdf

fred

Le 02/09/2015 à 06:27

Super merci je fais le test ce matin.

Bonne journée

Le 02/09/2015 à 10:00

je n'arrive pas cela bug sans arret

Voici ma macro. pourriez vous me dire ou la mettre ou bien l insérer

merci de votre aide.

Sub mail()

'

' trieusecolisnonsortit Macro

'

'

ActiveSheet.Range("$A$2:$W$32421").AutoFilter Field:=11, Criteria1:="NON"

'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 = "customs@linex.fr"

.CC = "ops@linexcdg.fr"

.Subject = "MAJ fret cathay à ne pas sortir"

.Attachments.Add TempFilePath & TempFileName & ".pdf"

.Body = "Bonjour, Merci de trouver ci joint la mise à jour des colis à ne pas sortir. Cordialement "

'.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

' ANNULATIONTRIEUSE Macro

'

'

ActiveSheet.Range("$A$2:$W$32421").AutoFilter Field:=11

ActiveWindow.SmallScroll Down:=-18

End Sub

Le 02/09/2015 à 10:20

Je n'arrive pas a intégrer la petite macro cela bug.

Ci joint ma macro serait il possible de l intégrer au bon endroit ?

Merci beaucoup.

Sub mail()

'

' trieusecolisnonsortit Macro

'

'

ActiveSheet.Range("$A$2:$W$32421").AutoFilter Field:=11, Criteria1:="NON"

'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 = "customs@linex.fr"

.CC = "ops@linexcdg.fr"

.Subject = "MAJ fret cathay à ne pas sortir"

.Attachments.Add TempFilePath & TempFileName & ".pdf"

.Body = "Bonjour, Merci de trouver ci joint la mise à jour des colis à ne pas sortir. Cordialement "

'.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

' ANNULATIONTRIEUSE Macro

'

'

ActiveSheet.Range("$A$2:$W$32421").AutoFilter Field:=11

ActiveWindow.SmallScroll Down:=-18

End Sub

Le 02/09/2015 à 10:25

la plage d'impression est fixe ou pas ??

en Nb de colonne ?

en nombre de ligne ?

si c'est pas fixe, comment savoir ou s’arrêter ? pour les colonnes ? pour les lignes ?

fred

Le 02/09/2015 à 10:29

Il faut l'impression de la colonne À a la colonne L.

Comme il y a un trie automatique le nombre de ligne importe peut

Merci

Le 02/09/2015 à 10:30

des données sont présentes dans toutes les lignes de la colonne A par exemple ??

fred

essaye avec ceci

remplace

With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf

par

With destwb
.PageSetup.PrintArea = "$A$" & [A65536].End(xlUp).Row & ":$L$" & [A65536].End(xlUp).Row
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
Le 02/09/2015 à 10:35

Ci joint une photo

A ce jour ça va jusqu'à la ligne 23 mais ça peut être plus

Cdlt

Le 02/09/2015 à 10:36

Ya pas de photo.....

Le 02/09/2015 à 10:38

J arrive aps la mettre j ai envoyé en mp

Cdlt

j ai essayé ta macro mais cela bug

Le 02/09/2015 à 10:50

donne moi le fichier cela sera plus simple en MP si tu veux

fred

Rechercher des sujets similaires à "macro envoyer pdf issue fichier"