Propriété des fichiers PDF exportés par macro

Bonjour à tous,

j'utilise une macro, qui en utilisant les offset m'exporte un fichier modèle avec des infos entrées à la volée dans des fichiers PDF.

Tout fonctionne parfaitement, sauf que lorsque j'ouvre mon PDF, je n'ai que la propriété name qui est identique sur tous les fichiers PDF, du coup j'ai besoin de les rassembler en un seul fichier, mais je voudrais avoir une indication dans les propriétés du fichier qui correspondent à son nom par exemple.

J'ai vu que cela fait partie du paramètre "IncludeDocProperties", mais je ne sais pas si je peux le modifier à ma guise pour insérer une chaîne de caractère pour m'aider à lui donner la propriété que je souhaite.

Ci dessous le code de la procédure :

Sub Btn_Export_results()

Dim newWst As Worksheet, curCell As Range
Dim Fichier As String, Fichier_pdf As String
Dim Impression As Boolean
Dim shFrom As Worksheet, shNew As Worksheet
Dim proGression As Double
Dim derniere_Ligne As Integer, x As Integer

Populate_liste_Cliquer

'**********************************
'Ici en utilisant shfrom au lieu the thisworkbook.sheets("fuille").... cela me permet de m affranchir d un eventuel changement de nom d onglets
Set shFrom = Sheet9
'Set curCellToModify = ThisWorkbook.Sheets("Feuil1").Range("C6")
Set curCell = shFrom.Range("B17")

'***************************************************
'créer une nouvelle feuille
Set shNew = Sheet8
Sheet8.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
'ThisWorkbook.Worksheets("Export_results_form").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set newWst = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

'**********************************
'Ne plus afficher les alertes genre overwrite un fichier sur un autre !
Application.DisplayAlerts = False

'**************************************
'Optimiser la vitesse d'execution, ne pas activer l'affichage à chauqe routine!
Application.ScreenUpdating = False

'****************************************************
'Creation du répertoire au début de la procedure
CheminSource = ThisWorkbook.Path
  On Error Resume Next
  MkDir CheminSource & "\" & "90_Export"
  On Error GoTo 0

'*******************************************
'Creation de la boite de dialogue pour demander si on veut imprimer les fiches
'en plus de l export
If MsgBox("Voulez vous imprimer les fiches de résultat en plus de les exporter en PDF ?", vbYesNo, "Demande de confirmation") = vbYes Then
        Impression = True
        Else
        Impression = False
End If

'Affichage de la userform Pregression
UserForm_demo.Show
UserForm_demo.Height = 75
proGression = 0
UserForm_demo.Image_barre.Width = proGression * 2
UserForm_demo.Label_barre.Caption = Str(proGression) & "%"
DoEvents
'derniere_Ligne = Range("C" & Rows.Count).End(xlUp).row

While curCell.Value <> vbNullString
    x = x + 1
    Set curCell = curCell.Offset(1, 0)
Wend

derniere_Ligne = x

Set curCell = shFrom.Range("B17")
x = 0

'boucle sur les entrées de la Feuil1
While curCell.Value <> vbNullString
    With newWst
        'copier les valeurs
        'offset(ROW, COLUMN)
        ' A gauche la feuille sur laquelle on veut copier (Export_results_form)
        '/ à droite la feuille d ou on prend les infos (Sheet9)

        'Nom
        .Range("E4").Value = curCell.Value
        'Position
        .Range("Q4").Value = curCell.Offset(0, 1).Value
        'Resultat 1er tyest
        .Range("M9").Value = curCell.Offset(0, 2).Value
        .Range("M10").Value = curCell.Offset(0, 3).Value
        .Range("M11").Value = curCell.Offset(0, 4).Value
        .Range("M12").Value = curCell.Offset(0, 5).Value
        .Range("M13").Value = curCell.Offset(0, 6).Value
        .Range("M14").Value = curCell.Offset(0, 7).Value

        'Resultat 2eme test
        .Range("K9").Value = curCell.Offset(0, 8).Value
        .Range("K10").Value = curCell.Offset(0, 9).Value
        .Range("K11").Value = curCell.Offset(0, 10).Value
        .Range("K12").Value = curCell.Offset(0, 11).Value
        .Range("K13").Value = curCell.Offset(0, 12).Value
        .Range("K14").Value = curCell.Offset(0, 13).Value

        'Minimum requested
        .Range("I9").Value = curCell.Offset(0, 14).Value
        .Range("I10").Value = curCell.Offset(0, 15).Value
        .Range("I11").Value = curCell.Offset(0, 16).Value
        .Range("I12").Value = curCell.Offset(0, 17).Value
        .Range("I13").Value = curCell.Offset(0, 18).Value
        .Range("I14").Value = curCell.Offset(0, 19).Value

        'New position possible
        'Colorindex 1 = Noir / 2 = Blanc / 5 = Bleu
        .Range("R9").Value = curCell.Offset(0, 20).Value
        If curCell.Offset(0, 20).Value = "" Then
            .Range("R8").Font.ColorIndex = 2
            .Range("R9").Font.ColorIndex = 2
        Else
            .Range("R8").Font.ColorIndex = 1
            .Range("R9").Font.ColorIndex = 5
        End If

        'Troubleshooting tests results
        .Range("R11").Value = curCell.Offset(0, 22).Value
        .Range("R12").Value = curCell.Offset(0, 21).Value

        'impripmer la feuille (printout) ou la sauvegarder (saveas)
        On Error Resume Next

'***********************************************************
         'Reglages des paramètres de la page
         .PageSetup.PrintArea = "$A$1:$U$54" ' zone impression
'        .Orientation = xlLandscape
         .PageSetup.Orientation = xlPortrait
         .PageSetup.Zoom = False
         .PageSetup.FitToPagesWide = 1
         .PageSetup.FitToPagesTall = False
'       .BlackAndWhite = True ' Noir et Blanc

        '*************************************************************
        'imprimer la feuille avec printout
        If Impression = True Then
        .PrintOut , Collate:=True
        End If

        '****************************************************************
        'Export au format PDF, avec overwrtie automatique
        Fichier_pdf = ThisWorkbook.Path & "\" & "90_Export\" & curCell.Offset(0, 1).Value & "-" & curCell.Value & ".pdf"
         .ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Fichier_pdf, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

        On Error GoTo 0
    End With
    'ici je décalle d'une ligne vers le bas (jusqu'à ce que la cellule soit vide !
    Set curCell = curCell.Offset(1, 0)

    'mise à jour progress bar
    x = x + 1
    proGression = Round((x * 100) / derniere_Ligne)
    If proGression > 0 Then
        UserForm_demo.Image_barre.Width = proGression * 2
        UserForm_demo.Label_barre.Caption = Str(proGression) & "%"
    End If
    DoEvents

Wend

'Progress à 100% (Barre height = 200, c'est pourquoi progress * 2 = barre.height
proGression = 100
UserForm_demo.Height = 100
UserForm_demo.Image_barre.Width = 200
UserForm_demo.Label_barre.Caption = "100%"
DoEvents

'***********************************************
'supprime la nouvelle feuille créée
newWst.Delete
shFrom.Activate

Set curCell = Nothing

Set shFrom = Nothing

Set shNew = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox ("Fichiers exportés dans le dossier : " & ThisWorkbook.Path & "\" & "90_Export\")

End Sub

Merci d'avance.

David