Microsoft 365 Macro - enregistrement sous-dossier

Smercierj

XLDnaute Nouveau
Bonjour,

J'ai créer un bon de livraison pour mon entreprise qui possède la macro suivante:

Sub Effacer()

Sheets("Bon").Range("A24:A51,B24:G51,B18:B23").Select

Selection.ClearContents


End Sub

Sub pdf()

nomdossier = Application.InputBox("Dossier d'enregistrement", "Enregistrer en PDF....!", "Bon de livraison")

dossier = ThisWorkbook.Path & "/" & nomdossier & "/"

On Error Resume Next

If dossier = True Then

GetAttr (dossier) And vbDirectory

Else

MkDir (dossier)

End If


En ce moment lorsque je pèse sur "Enregistrer en PDF " il s'enregistre dans un dossier nommé "Bon de livraison".

Toutefois, nous avons des codes différents. Exemple: CF-22006 / BL-22008NG / ET-22003, etc.

J'aimerais que, selon chaque début de code, qu'il s'enregistre dans un sous-dossier attitré. (dossier principal : Bon de livraison ; sous-dossiers: CF, BL, ET, etc.)


Je sais que c'est possible de le faire, mais je suis encore très débutante là-dedans et c'est important qu'on ait ces sous-dossiers afin de ne pas avoir un casse-tête.

Merci à tous
 

vgendron

XLDnaute Barbatruc
Bonjour
où trouve t on le code? dans le nom du fichier à enregistrer?
si oui, suffirait d'extraire les deux caractères du nom du fichier
Code=left(NomFichier,2)

et d'ajouter ce code dans le chemin d'enregistrement
dossier = ThisWorkbook.Path & "/" & nomdossier & "/" &code &"/"
 

Smercierj

XLDnaute Nouveau
non je parlais du code formé par les deux lettres (CF, BL, ET) que tu souhaites utiliser pour créer le sous repertoire
Nous écrivons ce code manuellement en référence à nos diverses catégories (ex.: CF pour canneberges fraiches, BL pour Bleuets, ET pour Écart de tri, etc.) Je veux que lors de l'enregistrement si c'est écrit CF dans ma colonne F3/G3, qu'il s'enregistre dans le sous-dossier CF. Mais si c'est BL, dans le sous-dossier BL. Et si le dossier n'est pas créer, qu'il le crée automatiquement...
 

vgendron

XLDnaute Barbatruc
et je t'ai déjà donné la solution en post 2
suffit d'adapter
VB:
Sub pdf()
SousDossier = Left(Range("F3"), 2)
nomdossier = Application.InputBox("Dossier d'enregistrement", "Enregistrer en PDF....!", "Bon de livraison")

dossier = ThisWorkbook.Path & "/" & nomdossier & "/" & SousDossier & "/"

On Error Resume Next

If dossier = True Then

GetAttr (dossier) And vbDirectory

Else

MkDir (dossier)

End If




ActiveSheet.ExportAsFixedFormat Type:=xltypdf, _
Filename:=dossier & Range("F2").Value & "_" & "commande N°" & " " & Range("F3").Value & ".pdf", _
quality:=xlQualityStandard, ignoreprintareas:=False, _
includedocproperties:=True, _
from:=1, to:=1, _
openafterpublish:=False


        Sheets("Bon").Range("G3").Value = Sheets("Bon").Range("G3").Value + 1



End Sub
 

Smercierj

XLDnaute Nouveau
et je t'ai déjà donné la solution en post 2
suffit d'adapter
VB:
Sub pdf()
SousDossier = Left(Range("F3"), 2)
nomdossier = Application.InputBox("Dossier d'enregistrement", "Enregistrer en PDF....!", "Bon de livraison")

dossier = ThisWorkbook.Path & "/" & nomdossier & "/" & SousDossier & "/"

On Error Resume Next

If dossier = True Then

GetAttr (dossier) And vbDirectory

Else

MkDir (dossier)

End If




ActiveSheet.ExportAsFixedFormat Type:=xltypdf, _
Filename:=dossier & Range("F2").Value & "_" & "commande N°" & " " & Range("F3").Value & ".pdf", _
quality:=xlQualityStandard, ignoreprintareas:=False, _
includedocproperties:=True, _
from:=1, to:=1, _
openafterpublish:=False


        Sheets("Bon").Range("G3").Value = Sheets("Bon").Range("G3").Value + 1



End Sub
Merci pour ton aide, malgré que la fille qui manque de bon sang, ne manque pas de respect elle au moins ;)
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof