Microsoft 365 Macro - enregistrement sous-dossier

[Smercierj]

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]

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 &"/"

 

[kiki29]

Salut, à lire puis adapter à ton contexte.

 

[Smercierj]

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 &"/"

Je ne suis pas sur de comprendre... Où trouve-t-on le code? Dans les projet VBA...?

 

[Smercierj]

oh lala! Étant très débutante, pourriez-vous m'aider svp?

Salut, à lire puis adapter à ton contexte.

 

[vgendron]

Exemple: CF-22006 / BL-22008NG / ET-22003, etc.

non je parlais du code formé par les deux lettres (CF, BL, ET) que tu souhaites utiliser pour créer le sous repertoire

 

[Smercierj]

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]

perso, les devinettes, ca me fatigue.. il faut que tu postes un fichier exemple...

 

[Smercierj]

perso, les devinettes, ca me fatigue.. il faut que tu postes un fichier exemple...

Ah bien là! Il fallait préciser!

 

[vgendron]

Ah bien là! Il fallait préciser!

pour ceux qui manquent de bon sens, c'est écrit dans la charte du forum..

 

[vgendron]

et je t'ai déjà donné la solution en post 2
suffit d'adapter

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]

et je t'ai déjà donné la solution en post 2
suffit d'adapter

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