XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule

[seb626]

bonjour, voici mon soucis, je cherche à automatiser l’enregistrement d'une feuille excel en pdf ( jusque là pas de soucis ), ce pdf devrait s'enregistrer dans un répertoire qui serait fonction d'une valeur de cellule.
exemple: j'ai 6 répertoire appelé: T1,T2, T3, T4, T5, T6
j'ai une cellule dans cette feuille dont je peux choisir entre T1, T2 T3 T4 T5 T6
en fonction de ce choix, lors de l'enregistrement celui-ci doit se retrouver dans le répertoire associé ( le top serait même de créer un sous dossier avec comme nom T1 ( si c'est notre sélection) et date par exemple et on enverrai toute les sauvegarde T1 du jour dans ce sous dossier mais là cela devient peut être une usine a gaz lol )

cette feuille enregistré en pdf devrait être enregistré sous le nom de ex: T1 "date" "heure/min" dans le répertoire concerné

ce pdf pourra être affiché et imprimé en paralèlle

j'ai par le biais de certaine recherche et quelque modification réalisé un premier jus, mais il me manque la gestion des répertoire, le reste fonctionne
voici l'écriture:

Sub ImprimerPDF()
Call Enregistrer_PDF
End Sub


Function Enregistrer_PDF() As Boolean ' Copie les feuilles dans un nouveau PDF
Dim CetteFeuille As String, CeFichier As String, NomRépertoire As String
Dim EnrSous As String

Application.ScreenUpdating = False

' Obtention du nom de sauvegarde du fichier
CetteFeuille = ActiveSheet.Name
CeFichier = ActiveWorkbook.Name
NomRépertoire = ActiveWorkbook.Path
EnrSous = NomRépertoire & "\" & "DAP " & Range("A4").Value & "_" & Format(Now, "yymmdd") & "_" & Format(Now, "hh") & "h" & Format(Now, "mm") & ".pdf"

'Définition de la qualité d'impression
On Error Resume Next
ActiveSheet.PageSetup.PrintQuality = 600
Err.Clear
On Error GoTo 0

' Explique à l'utilisateur comment envoyer le fichier
On Error GoTo ErreurRefLib
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=EnrSous, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
On Error GoTo 0

EnregistrerSeulement:
MsgBox "Une copie de cette feuille a été sauvegardée avec succès en format .pdf " & vbCrLf & vbCrLf & EnrSous & _
" Si le document ne s'affiche pas correctement, ajustez vos paramètres d'impression et ré-essayez."

Enregistrer_PDF = True
GoTo FinMacro

ErreurRefLib:
MsgBox "Impossible de sauvegarder en pdf. Référence introuvable ou manquante."
Enregistrer_PDF = False
FinMacro:
End Function


merci d'avance pour votre aide

 

[Phil69970]

Bonjour @seb626 et bienvenu sur XLD

Ma boule de cristal est cassée aujourd'hui donc en l’état je ne peux pas t'aider

 

[seb626]

le voilà, merci pour ton conseil, j'ai crée un fichier test pour l'occasion

 

[Phil69970]

@seb626

j'ai crée un fichier test pour l'occasion

Tu plaisantes j’espère si tu appelles cela un fichier test en tout cas cela sera sans moi !!!

 

[seb626]

@seb626


Tu plaisantes j’espère si tu appelles cela un fichier test en tout cas cela sera sans moi !!!

dsl que tu le prennes comme ça, le fichier origine concerne des données sensibles auquel je ne peux en divulguer le contenu, c'est la raison pour laquelle j'ai fais un fichier test , c'est une feuille vide c'est vrai mais ma question ne concerne en rien le contenu mais l’enregistrement.
maintenant si vous ne voulez pas m'aider tempis

merci quand même pour avoir pris le temps de répondre...

Cordialement

au passage je viens de m'apercevoir que le fichier test n'avait pas le code que j'ai donné dans ma question donc je l'ai ajouté, voici le fichier avec le code vba . merci d'avance à celui qui voudra m'aider

bonne journée à tous

 

[Phil69970]

@seb626

le fichier origine concerne des données sensibles auquel je ne peux en divulguer le contenu,

Rien ne t’empêche de fournir un fichier représentatif

C'est quoi représentatif ?

- représentatif, même organisation des lignes et des colonnes, mêmes libellés, même nom des TS, mêmes noms de feuilles...
- anonymisé, pas de données personnelles réelles tels nom, n° sécu, adresse ... remplacé par Nom1, Nom2 etc ....
- simplifié, une quinzaine de lignes reproduisant l'ensemble des différents cas envisageables (Avec le résultat souhaité éventuellement)

Si cela fonctionne sur le fichier fourni et pas sur le vrai fichier c'est qu'il n'est en rien représentatif ou que tu n'as pas su transposer ce qui devrait être un simple copier coller du code.

Bonne lecture