Sujet Précédent Sujet Suivant

Enregistrement PDF VBA

Fermé
Pimp92a Messages postés 418 Date d'inscription vendredi 26 juin 2009 Statut Membre Dernière intervention 20 novembre 2022 - 14 déc. 2009 à 12:42
Samygale Messages postés 45 Date d'inscription jeudi 10 décembre 2009 Statut Membre Dernière intervention 18 décembre 2009 - 16 déc. 2009 à 14:36
Bonjour le forum,

j'enregistre mon classeur Excel grâce à une macro. Problème : quand je fais cela, il ne garde pas ma mise en forme, alors que lorsque j'enregistre manuellement mon classeur ma mise en forme est respectée. Comment faire?? Merci d'avance
A voir également:

10 réponses

Réponse 1 / 10
Samygale Messages postés 45 Date d'inscription jeudi 10 décembre 2009 Statut Membre Dernière intervention 18 décembre 2009 1
14 déc. 2009 à 14:34
Hola,
Peut-être redéfinir la les paramètres et la zone d'impression avant l'envoi vers l'imprimante... ?
0
Réponse 2 / 10
Pimp92a Messages postés 418 Date d'inscription vendredi 26 juin 2009 Statut Membre Dernière intervention 20 novembre 2022 44
14 déc. 2009 à 15:06
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
0
Réponse 3 / 10
Pimp92a Messages postés 418 Date d'inscription vendredi 26 juin 2009 Statut Membre Dernière intervention 20 novembre 2022 44
15 déc. 2009 à 10:24
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
0
Réponse 4 / 10
Samygale Messages postés 45 Date d'inscription jeudi 10 décembre 2009 Statut Membre Dernière intervention 18 décembre 2009 1
15 déc. 2009 à 10:28
Re,
Peux-tu mettre le code de ta macro qui enregistre ton fichier ? D'ailleurs quel est le rapport avec PDF ?
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 10
Pimp92a Messages postés 418 Date d'inscription vendredi 26 juin 2009 Statut Membre Dernière intervention 20 novembre 2022 44
15 déc. 2009 à 11:20
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]
0
Réponse 6 / 10
Pimp92a Messages postés 418 Date d'inscription vendredi 26 juin 2009 Statut Membre Dernière intervention 20 novembre 2022 44
15 déc. 2009 à 11:27
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]
0
Réponse 7 / 10
Pimp92a Messages postés 418 Date d'inscription vendredi 26 juin 2009 Statut Membre Dernière intervention 20 novembre 2022 44
15 déc. 2009 à 18:30
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??
0
Réponse 8 / 10
Samygale Messages postés 45 Date d'inscription jeudi 10 décembre 2009 Statut Membre Dernière intervention 18 décembre 2009 1
16 déc. 2009 à 11:25
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 :)
0
Réponse 9 / 10
Pimp92a Messages postés 418 Date d'inscription vendredi 26 juin 2009 Statut Membre Dernière intervention 20 novembre 2022 44
16 déc. 2009 à 11:31
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
0
Réponse 10 / 10
Samygale Messages postés 45 Date d'inscription jeudi 10 décembre 2009 Statut Membre Dernière intervention 18 décembre 2009 1
16 déc. 2009 à 14:36
De rien ... crois bien que je compatis :S
0