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
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
Dernière édition: