Excel - VBA en PDF problème de mise en forme
L
Bonjour à tous,
Je dois réaliser pour mon entreprise un fichier Excel avec une fonction VBA permettant de prendre des informations dans un fichier Excel pour ensuite le transformer en PDF. Pour cela, j'ai créé un code VBA mais le rendu est mauvais. Pouvez-vous m'aider svp ? Voici mon code :
Sub CreerAttestationPDF()
Dim ws As Worksheet
Dim tempSheet As Worksheet
Dim pdfPath As String
Dim nom As String, poste As String
Dim ligne As Long
Dim texteAttestation As String
Dim lieu As String, dateAttest As String
Dim mois As String, annee As String
Dim montant As Variant
Dim lignesValides As Variant
Dim trouve As Boolean
Dim i As Long
Set ws = ThisWorkbook.Sheets("Janvier") ' Feuille source mettre le nom de la feuille ici
' Liste des lignes autorisées
lignesValides = Array(6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, _
22, 23, 24, 25, 26, 27, _
30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, _
49, 50, 51, 52, 53, 54, _
58, 59, 60, 61, 62, 63, _
67, 68, _
72, 73, 74, 75, 76, 77, 78, 79, 80, _
84, 85, _
89, 90, 91, _
95, 96, _
100, 101, 102)
' Demande du numéro de ligne
ligne = Application.InputBox("Numéro de ligne du collaborateur :", Type:=1)
' Vérifier si la ligne est dans la liste des lignes valides
trouve = False
For i = LBound(lignesValides) To UBound(lignesValides)
If ligne = lignesValides(i) Then
trouve = True
Exit For
End If
Next i
If Not trouve Then
MsgBox "Veuillez rentrer un numéro de ligne valide svp !", vbExclamation
Exit Sub
End If
' Données générales
nom = ws.Range("C" & ligne).Value
poste = ws.Range("B" & ligne).Value
montant = ws.Range("V" & ligne).Value
lieu = ws.Range("G2").Value
dateAttest = ws.Range("B1").Value
mois = ws.Range("C2").Value
annee = ws.Range("B2").Value
' Texte commun d'attestation
texteAttestation = "Je soussigné(e), " & nom & ", " & poste & " du Groupe Bernard," & vbCrLf & vbCrLf & _
"Atteste avoir bien reçu la prime de " & montant & " € pour le mois de " & mois & " " & annee & "." & vbCrLf & vbCrLf & _
"Fait pour servir et valoir ce que de droit." & vbCrLf & vbCrLf & _
"Fait à " & lieu & ", le " & dateAttest & vbCrLf & vbCrLf & _
"Signature précédée de la mention ""Lu et approuvé"" :"
' Création feuille temporaire dans Excel
Set tempSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
tempSheet.Name = "TempAttestation"
With tempSheet
.Cells.Clear
.Cells.Font.Name = "Arial"
' Titre
With .Range("A1:F1")
.Merge
.Value = "ATTESTATION DE PRIME"
.Font.Bold = True
.Font.Size = 20
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
' Informations
With .Range("A3:F3")
.Merge
.Value = "Collaborateur : " & nom
.Font.Bold = True
.Font.Size = 12
End With
With .Range("A4:F4")
.Merge
.Value = "Poste : " & poste
.Font.Size = 12
End With
' Texte principal
With .Range("A6:F14")
.Merge
.Value = texteAttestation
.WrapText = True
.Font.Size = 12
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
End With
' Signature
With .Range("A16:F16")
.Merge
.Value = "Signature :"
.Font.Bold = True
.Font.Size = 12
End With
With .Range("A17:F20")
.Merge
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
.Columns("A:F").ColumnWidth = 14
End With
' Mise en page PDF
With tempSheet.PageSetup
.Orientation = xlPortrait
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.TopMargin = Application.CentimetersToPoints(2)
.BottomMargin = Application.CentimetersToPoints(2)
.LeftMargin = Application.CentimetersToPoints(2)
.RightMargin = Application.CentimetersToPoints(2)
.CenterHorizontally = True
End With
' Export PDF
pdfPath = "C:\Users\peillol\OneDrive - BERNARD PARTICIPATIONS\Bureau\Stellantis Calculatrice - attestation prime\" & _
"Attestation_" & nom & ".pdf"
tempSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
' Supprimer feuille temporaire
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True
MsgBox "PDF créé avec succès à l’emplacement suivant :" & vbCrLf & pdfPath, vbInformation
End Sub
J
Bonjour
Pouvez vous nous joindre un exemple anonymisé de votre fichier ?
Crdlt
L
J
Bonjour
Un exemple en modifiant le vba
si cela te convient je te renvoies le fichier modifié
L
Oui, c'est parfait ça, merci beaucoup :)
J
en retour votre fichier
il vous faudra uniquement modifier dans le code cette partie et remettre ce qui vous concerne
'Export PDF
pdfPath = "C:\Users\" & Environ("USERNAME") & "\Documents\mon_fichier.pdf"
tempSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=TrueL
Super, c'est parfait, merci beaucoup !
J
Bonjour
Merci pour le retour pensez à passer le sujet en résolu
Crdlt