Enregistrement PDF VBA

Hola,
Peut-être redéfinir la les paramètres et la zone d'impression avant l'envoi vers l'imprimante... ?

Pour la zone d'impression justement je l'ai fixée d'avance. Je vais regarder au niveau des options d'enregistrement

En tout cas merci de m'avoir répondu

J'ai essayé les options d'impressions, mais rien n'y fait, la mise en forme n'est toujours pas conservée.

Comment faire??

Merci

Re,
Peux-tu mettre le code de ta macro qui enregistre ton fichier ? D'ailleurs quel est le rapport avec PDF ?

J'ai essayé les différentes options et J'ai essayé avec un autre fichier et la mise en forme n'est pas conservée. C'est étrange car quand j'imprime en pdf, la mise en forme est respectée, et quand j''enregistre en pdf, la mise en forme part en cacahuètes. Je poste ici mon fichier exemple et le code que j'utilise dans le vrai fichier

http://www.cijoint.fr/cjlink.php?file=cj200912/cijNoJEhJe.xlsx

[code] Sub Macro2()
'
' Macro2 Macro
'

'
Dim var11 As String
Dim var12 As String
Dim today As Date
x = Application.OperatingSystem
today = Sheets("Saisie").Range("BE45").Value
var11 = Sheets("Report FAS2020").Range("B8").Value
var12 = Sheets("Report FAS2020").Range("B9").Value
Sheets("Report FAS2020").Select
Range("A1:M81").Select
Range("M1").Activate
ActiveSheet.PageSetup.PrintArea = "$A$1:$M$81"

If x <> "Windows (32-bit) NT 6.00" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Environ("USERPROFILE") & "\Mes documents\" & "xxx_" & var11 & "_" & var12 & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

Dim OutlookApp As New Outlook.Application
Dim Mess As Outlook.MailItem, Desti As String
Dim PJ As String, fich As String

Chemin = Environ("USERPROFILE") & "\Mes documents\"
Desti = ""
Set OutlookApp = Outlook.Application
Set Mess = OutlookApp.CreateItem(olMailItem)
With Mess
.Display
fich = Dir(Chemin & "xxx_" & var11 & "_" & var12 & ".pdf")
Do While fich <> ""
.Attachments.Add Chemin & fich
fich = Dir
Loop
.Subject = " xxx : Cotation xxx FAS2000_" & var11 & "_" & var12
.HTMLBody = "<font face =timesnewroman size=+1>Bonjour,</FONT>" & "<br>" & "<br>" & "<font face=timesnewroman size =+1>Veuillez trouver ci-joint votre cotation pour</FONT>" & " " & var12 & "<font face=timesnewroman size =+1>.</FONT>" & "<br>" & "<br>" & "<font face=timesnewroman size =+1>Les prix de ventes sont exclusivement réservés aux revendeurs partenaires . Les prix indiqués devront faire l'objet d'une cotation contractuelle</FONT>" & "<br>" & "<br>" & "<font face =timesnewroman size=+1>Cordialement</FONT>" + .HTMLBody
End With
End If

If x = "Windows (32-bit) NT 6.00" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Environ("USERPROFILE") & "\Documents\" & "xxx_" & var11 & "_" & var12 & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Chemin = Environ("USERPROFILE") & "\Documents\" & "xxx_" & var11 & "_" & var12 & ".pdf"
Desti = ""
Set OutlookApp = Outlook.Application
Set Mess = OutlookApp.CreateItem(olMailItem)
With Mess
.Display
fich = Dir(Chemin & "xxx_" & var11 & "_" & var12 & ".pdf")
Do While fich <> ""
.Attachments.Add Chemin & fich
fich = Dir
Loop
.Subject = " xxx: Cotation xxx FAS2000_" & var11 & "_" & var12
.HTMLBody = "<font face =timesnewroman size=+1>Bonjour,</FONT>" & "<br>" & "<br>" & "<font face=timesnewroman size =+1>Veuillez trouver ci-joint votre cotation pour</FONT>" & " " & var12 & "<font face=timesnewroman size =+1>.</FONT>" & "<br>" & "<br>" & "<font face=timesnewroman size =+1>Les prix de ventes sont exclusivement réservés aux revendeurs partenaires xxx. Les prix indiqués devront faire l'objet d'une cotation xxx contractuelle</FONT>" & "<br>" & "<br>" & "<font face =timesnewroman size=+1>Cordialement</FONT>" + .HTMLBody
End With
End If

End Sub

Sub Macro3()
'
' Macro3 Macro
'

'
Dim var13 As String
Dim var14 As String
Dim today As Date
x = Application.OperatingSystem
var13 = Sheets("Report FAS2050").Range("B8").Value
var14 = Sheets("Report FAS2050").Range("B9").Value
Sheets("Report FAS2050").Select
Range("A1:H87").Select
Range("H1").Activate
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$87"

If x <> "Windows (32-bit) NT 6.00" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Environ("USERPROFILE") & "\Mes documents\" & "xxx_" & var13 & "_" & var14 & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

Dim OutlookApp As New Outlook.Application
Dim Mess As Outlook.MailItem, Desti As String
Dim PJ As String, fich As String

Chemin = Environ("USERPROFILE") & "\Mes documents\"
Desti = ""
Set OutlookApp = Outlook.Application
Set Mess = OutlookApp.CreateItem(olMailItem)
With Mess
.Display
fich = Dir(Chemin & "xxx_" & var13 & "_" & var14 & ".pdf")
Do While fich <> ""
.Attachments.Add Chemin & fich
fich = Dir
Loop
.Subject = " xxx : Cotation xxx FAS2000_" & var13 & "_" & var14
.HTMLBody = "<font face =timesnewroman size=+1>Bonjour,</FONT>" & "<br>" & "<br>" & "<font face=timesnewroman size =+1>Veuillez trouver ci-joint votre cotation pour</FONT>" & " " & var14 & "<font face=timesnewroman size =+1>.</FONT>" & "<br>" & "<br>" & "<font face=timesnewroman size =+1>Les prix de ventes sont exclusivement réservés aux revendeurs partenaires xxx. Les prix indiqués devront faire l'objet d'une cotationxxx contractuelle</FONT>" & "<br>" & "<br>" & "<font face =timesnewroman size=+1>Cordialement</FONT>" + .HTMLBody
End With
End If

If x = "Windows (32-bit) NT 6.00" Then

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Environ("USERPROFILE") & "\Documents\" & "xxx_" & var11 & "_" & var12 & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Chemin = Environ("USERPROFILE") & "\Documents\" & "xxx_" & var11 & "_" & var12 & ".pdf"
Desti = ""
Set OutlookApp = Outlook.Application
Set Mess = OutlookApp.CreateItem(olMailItem)
With Mess
.Display
fich = Dir(Chemin & "xxx_" & var13 & "_" & var14 & ".pdf")
Do While fich <> ""
.Attachments.Add Chemin & fich
fich = Dir
Loop
.Subject = " xxx : Cotation xxx FAS2000_" & var13 & "_" & var14
.HTMLBody = "<font face =timesnewroman size=+1>Bonjour,</FONT>" & "<br>" & "<br>" & "<font face=timesnewroman size =+1>Veuillez trouver ci-joint votre cotation pour</FONT>" & " " & var14 & "<font face=timesnewroman size =+1>.</FONT>" & "<br>" & "<br>" & "<font face=timesnewroman size =+1>Les prix de ventes sont exclusivement réservés aux revendeurs partenaires xxx. Les prix indiqués devront faire l'objet d'une cotationxxx contractuelle</FONT>" & "<br>" & "<br>" & "<font face =timesnewroman size=+1>Cordialement</FONT>" + .HTMLBody
End With
End If
End Sub [code]

A la limite, le bout de code qui est censé respecter ma mise en forme, c'est :

[code] Sheets("Report FAS2050").Select
Range("A1:H87").Select
Range("H1").Activate
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$87" [code]

Ok j'ai réussi à passer par un chemin très bizarre, en faisant un aperçu avant impression, il garde la mise en forme!! Mais j'aimerai que l'utilisateur n'ait pas à faire échap pour quitter l'aperçu, donc j'ai fait SendKeys {ESC}, ou encore Sendkeys {ESCAPE}, vbkeyEscape, avec des guillemets et tout et tout, Application.SendKeys etc mais ça ne marche pas. Quelle est la bonne commande??

Re,

Il semble que l'instruction SendKeys soit exécutée avant que l'aperçu ne soit complètement chargé... un petit article sur le sujet :
https://www.tek-tips.com/faqs.cfm?fid=5037

bon courage pour la fin :)

Merci pour l 'article,

je suis dégouté parce que maintenant ma manip aperçu avant impression ne fonctionne plus, la mise en forme se barre comme avant :( en même temps, c'était tellement pas logique que ça ne me surprend pas, tan pis

Merci Samygale d'avoir étudié mon problème

De rien ... crois bien que je compatis :S