Créer fichier Pdf
Bonjour à tous,
Je suis confronté à un problème avec la génération de fichier PDF:
Je souhaite générer un fichier PDF issue de plusieurs onglets, le tout dynamiquement en fonction d'un critère, le critère effectue 3 types d'impressions PDF différentes:
J'ai créer un onglet "Impression" détaillant les 3 types d'impressions avec les "Ranges" à imprimer et les "Rows" a masquer en fonction de ce critère.
Voici le code que j'ai réalisé:
Sub CreerPDF()
Dim zone, ID$, c
Dim ws As Worksheet, CBD
Dim Unionplage As Range
Dim plage(), lst()
Dim sRep As String, sFilename As String
'#####################################################
'Déclaration des Objets
'#####################################################
Set ws = Sheets("Impression")
Set CBD = Sheets("Edition_CUMA_Compta").Shapes("logo")
'#####################################################
'Déclaration des variables
'#####################################################
'Critère qui me permet de générer le PDF désiré
ID = Sheets("IDENTIFICATION").Range("E7")
'Récupére la colonne à imprimer en fonction de l'ID
zone = ws.Range("Tableau_Impression" & "[" & ID & "]")
'Affectation du tableau des impressions
tablo = ws.Range("Tableau_Impression")
'#####################################################
'Copie du Logo pour l'insérer dans l'entête des pages
'#####################################################
CBD.Copy
chm = ThisWorkbook.Path & "\"
With Sheets("Impression").ChartObjects.Add(0, 0, CBD.Width, CBD.Height).Chart
.Paste
'Sauvegarde temporaire de l'image du graphique au format jpg
.Export chm & "logo.jpeg", "JPG"
End With
With Sheets("Impression")
'Suppression de l'image
.ChartObjects(Sheets("Impression").ChartObjects.Count).Delete
End With
'#####################################################
'MFC des onglets (Masquage des lignes)
'#####################################################
'Controle du type de afin de masquer les lignes en fonction de l'ID
Typ = IIf(Left(ID, 1) = 2, 2, 3)
For i = 2 To UBound(tablo, 1)
If Sheets(tablo(i, 1)).ProtectContents = True Then Sheets(tablo(i, 1)).Unprotect
If tablo(i, 6) <> "" Then
lgn = Split(tablo(i, 6), "/")
'Les plages (Rows) sont séparées par "/"
For Each c In lgn
Sheets(tablo(i, 1)).Rows(c).Hidden = True
Next c
End If
If tablo(i, 7) <> "" Then Sheets(tablo(i, 1)).Rows(tablo(i, 7)).Hidden = True
Next i
'#####################################################
'Création d'un array avec les plages à Imprimer
'#####################################################
'Initialisation des controles de dimensons du tableau
y = 1: x = -1
For Each c In zone
y = y + 1
If Not IsEmpty(c) Then
If c = "X" Then
x = x + 1
ReDim Preserve plage(x)
plage(x) = ws.Range("A" & y).Value
plg = ws.Range("E" & y).Value
'Sheets(plage(x)).Cells.PageBreak = xlNone
With Sheets(plage(x)).PageSetup
.PrintArea = Sheets(plage(x)).Range(plg).Address
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = False
.Zoom = False
.PaperSize = xlPaperA4
.RightFooter = "&8&P/&N"
.CenterHorizontally = True
.CenterVertically = False
With .LeftHeaderPicture
.Filename = chm & "logo.jpeg"
.Height = 275.25
.Width = 46.5
.Brightness = 0.36
.ColorType = msoPictureGrayscale
End With
End With
End If
End If
Next c
Kill chm & "logo.jpeg"
'#####################################################
'Génération du fichier PDF
'#####################################################
Sheets(plage()).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\select_sheets.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("IDENTIFICATION").Activate
'#####################################################
'MFC des onglets (Affichage des lignes)
'#####################################################
For i = 2 To UBound(tablo, 1)
If tablo(i, 6) <> "" Then
lgn = Split(tablo(i, 6), "/")
For Each c In lgn
Sheets(tablo(i, 1)).Rows(c).Hidden = False
Next c
End If
If tablo(i, 7) <> "" Then
Sheets(tablo(i, 1)).Rows(tablo(i, 7)).Hidden = False
End If
If Sheets(tablo(i, 1)).ProtectContents = False Then Sheets(tablo(i, 1)).Protect
Next i
End Sub
Comme les "Range" n'ont pas les mêmes dimensions, je me suis dis que sa venait peut être de la largeur totales des ranges qui étaient différentes entre chaque onglet, donc j'ai réalisé un code pour redimensionner tout les onglets par l'impression pour que le range total de chaque onglet soit égale sur tous les onglets:
Voici le code que j'ai réalisé, pour redimensionner le range de chaque onglet:
Sub dim_range()
Dim largeur As Double, largeur_max As Double
Dim colonne As Range
Dim prtarea, tablo, Val
Dim i&, j&, Num_col&, N_max&
Dim nom$
Dim Max As Double
'Déclaration du tableau des onglets concernés par les impressions
tablo = Sheets("Impression").Range("Tableau_Impression")
'##########################################################
'Recherche parmis les onglets, le range total le plus grand
'##########################################################
For i = 2 To UBound(tablo, 1)
If tablo(i, 1) <> "" Then
largeur = 0
If Sheets(tablo(i, 1)).ProtectContents = True Then Sheets(tablo(i, 1)).Unprotect
prtarea = Sheets(tablo(i, 1)).PageSetup.PrintArea
Set colonne = ActiveSheet.Range(Mid(prtarea, 7, 1) & "1")
Num_col = colonne.Column
For j = 2 To Num_col
largeur = largeur + Sheets(tablo(i, 1)).Columns(j).ColumnWidth
Next j
If largeur > largeur_max Then largeur_max = largeur: nom = tablo(i, 1)
End If
Next i
'############################################################
'Boucle sur tous les onglets afin de redimenssionner le range
'############################################################
For i = 2 To UBound(tablo, 1)
If tablo(i, 1) <> "" Then
largeur = 0
prtarea = Sheets(tablo(i, 1)).PageSetup.PrintArea
Set colonne = ActiveSheet.Range(Mid(prtarea, 7, 1) & "1")
Num_col = colonne.Column
For j = 2 To Num_col
largeur = largeur + Sheets(tablo(i, 1)).Columns(j).ColumnWidth
Next j
Do While largeur < largeur_max
For j = 2 To Num_col
Set colonne = Sheets(tablo(i, 1)).Columns(j)
colonne.ColumnWidth = colonne.ColumnWidth + 1
largeur = largeur + 1
If largeur > largeur_max Then
Max = 0
For x = 2 To Num_col
Set colonne = Sheets(tablo(i, 1)).Columns(x)
If colonne.ColumnWidth > Max Then Max = colonne.ColumnWidth: N_max = x
Next x
Set colonne = Sheets(tablo(i, 1)).Columns(N_max)
colonne.ColumnWidth = colonne.ColumnWidth - (largeur - largeur_max)
largeur = largeur - (largeur - largeur_max)
If largeur = largeur_max Then Exit For
Exit For
End If
Next j
Loop
If Sheets(tablo(i, 1)).ProtectContents = False Then Sheets(tablo(i, 1)).Protect
End If
Next i
End SubMalgré ce code et effectivement le nombre de colonne est différent entre chaque onglet mais la taille totale du range est la même, je me retrouve encore confronté a ces largeurs différentes lors de l'ouverture du document généré. Avez vous une solution pour contourner ce problème? Merci à vous
Bonjour,
Les paramètres d'impression produisent des problèmes assez complexes à résoudre et c'est vrai que le résultat que vous obtenez est étonnant.
Je n'ai pas vraiment d'idée mais j'essaierais quand même :
With Sheets(plage(x)).PageSetup
.PrintArea = Range(plg).Address
.Orientation = xlPortrait '<<< variable ?
.Zoom = False 'ordre changé au cas où cela aurait une incidence
.FitToPagesWide = 1
.FitToPagesTall = False
.leftmargin = ??? 'définir les marges
.rightmargin = ??? 'idem
.PaperSize = xlPaperA4
.RightFooter = "&8&P/&N"
.CenterHorizontally = True
.CenterVertically = False
'bloc leftheaderpicture
End WithAprès, peut-être que vous pourriez rendre l'orientation variable (xlportrait, xllandscape) en fonction du rapport entre la largeur des colonnes et la hauteur des lignes de la zone...
Vous n'avez que des feuilles de calcul à imprimer ? Ca pourrait être une explication aussi...
Cdlt,
Bonjour et merci pour ta réponse 3GB,
Je viens de tester et là ou mon problème était présent presque à chaque page et avec une forte différence de largeur, maintenant je n'ai plus que 3 pages avec des largeurs plus grande et de peu. Je vais essayer d'affiner les marges pour voir si sa peut résoudre le problème.
Actuellement voici les valeurs de marge que j'ai indiquées:
.LeftMargin = 72 'définir les marges
.RightMargin = 72 Sinon je pensais ré imprimer le PDF une seconde fois, car j'ai essayé de faire l'opération manuellement, c'est à dire ré imprimer le "pdf" en "pdf" depuis Acrobat et sa résolvait le problème. Mais je ne voyais pas comment faire cette opération en VBA.
Re Florian,
Tant mieux, parce que j'ai répondu vraiment sans conviction. Mais je crois en effet que les propriétés influencent les autres selon leur ordre de définition.
Je tenterais pour voir de définir .papersize = xlpaperA4 avant la propriété .zoom, puis de lui affecter la valeur xlPaperA4Small pour voir ou de ne carrément pas la définir. Mais c'est toujours sans conviction
S'il est possible d'y parvenir en passant uniquement par VBA, c'est quand même mieux...
Bon courage,
Je n'ai pas encore effectué de test en jouant avec les marges, mais je viens d'essayer "xlPaperA4Small" mais le code émet une erreur, il n'apprécie pas ce type de papier ;).
Je pense aussi que l'ordre à de l'importance, j'ai essayé de pas renseigner le type de papier mais j'ai encore ce problème de largeur.
Ah mince !
Honnêtement, je suis un peu à court d'idée malheureusement... J'essaierais de tout remonter avant zoom :
With Sheets(plage(x)).PageSetup
.PrintArea = Range(plg).Address
.PaperSize = xlPaperA4
.Orientation = xlPortrait '<<< variable ?
.leftmargin = ??? 'définir les marges
.rightmargin = ??? 'idem
.CenterHorizontally = True
.CenterVertically = False
.RightFooter = "&8&P/&N"
.Zoom = False 'ordre changé au cas où cela aurait une incidence
.FitToPagesWide = 1
.FitToPagesTall = False
'bloc leftheaderpicture
End Withmais si ça ne passe pas, je te souhaite d'obtenir une meilleure réponse car je ne vois pas vraiment d'alternative...
Cdlt,
Merci 3GB,
Après avoir essayé ta dernière solution et jouer avec les marges, le problème est toujours présent. Est ce que tu aurais une solution pour réimprimer le pdf pour faire un essai ?
Je ne vois pas comment rouvrir le fichier pdf et le faire réimprimer avec pdfcreator.
Je ne sais pas si c'est la meilleure solution. Peut-être qu'il faudrait essayer toutes les possibilités avant...
En tout cas, voici un essai :
'FONCTION A DECLARER EN TETE DE MODULE
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'CODE A EXECUTER APRES LA CREATION DU PDF
Sub test()
With Application
sImpDefaut = .ActivePrinter 'nom imprimante pas défaut stockée
.ActivePrinter = "PDFCreator" 'imp par défaut devient "PDFCreator" <<< PEUT ETRE A ADAPTER !!!
Chemin = ThisWorkbook.Path & "\select_sheets.pdf" 'chemin pdf
ShellExecute le_form.hwnd, "print", Chemin, "", "", 1 'fonction imprime document sans ouvrir (donc censée créer un pdf ici)
.ActivePrinter = sImpDefaut 'rétablit imprimante initiale
End With
'Shell "TASKKILL /IM AcroRd32.exe /F" 'le cas échéant, ferme le fichier pdf si le pdf creator a entrainé son ouverture
End SubC'est vraiment à voir car il y a plusieurs incertitudes dans ce code. Déjà, je ne maitrise pas du tout les commandes Shell. Ensuite, je n'ai jamais essayé d'imprimer un document via le pdfcreator alors je ne connais pas le résultat, d'autant plus que le fichier est fermé. Si besoin on essaiera de l'ouvrir. Il faut bien être attentif au nom de l'imprimante PDFCreator qui est probablement à adapter.
Bonne soirée,
Bonjour 3GB, j'ai essayé la commande Shell mais elle ne veut s'exécuter, elle bloque sur les lignes :
.ActivePrinter = "PDFCreator"
Si je la met par défaut manuellement afin d'inhiber cette ligne le programme bloque à la ligne suivante:
ShellExecute le_form.hwnd, "print", Chemin, "", "", 1 'fonction imprime document sans ouvrir (donc censée créer un pdf ici)
Dans tous les cas, comme tu as pu le dire, je ne pense pas non plus que ce soit la meilleur solution, en espérant qu'une personne pourra nous guider sur ce problème car malgré mes tests a tâtonnement sur les valeurs, j'ai toujours un décalage de largeur de feuille.Salut Florian,
Je pense que c'est le premier paramètre de ShellExecute qui bloque (le_form.hwnd). Pour l'instant, je ne le comprends pas
Mais il est vrai que trouver le moyen de régler le problème uniquement avec les mises en page, ce serait mieux...