Verifier existance dossier sinon le créer
bonjour à toutes et tous
je reviens vers vous afin de vous demander encore un peu d'aide.
Dans mon fichier sur la feuille "Factures" j'ai créer un bouton "Enregistrer" qui fait appel à une macro "enregister".
cette macro m'enregistre la facture dans un dossier année (exemple 2016,2017,2018 etc)
une msgbox me demande dans quel dossier enregistrer la facture.
le problème est que si le dossier n'est pas il ne sera pas créer et l'enregistrement ne se fera pas.
Comment peut on faire pour que lorsque l'on rentre l'année du dossier d'enregistrement dans la msgbox si celui ci n'existe pas il se créé automatiquement et que l'enregistrement se fasse et dans la cas ou il existe l'enregistrement se fasse.
je pense qu'il faille créer une boucle mais je suis un peu novice dans le vba
Merci pour votre aide
Bonjour ci joint une petite fonction qui test l'existence d'un dossier si il n'existe pas creation
modifier ton code en faisant appel a cette fonction
fred
Sub test_repertoire(chemin As String)
Dim fs As object
Set fs = CreateObject("Scripting.FileSystemObject") ' initialisation de la variable
If fs.FolderExists(chemin) Then ' le repertoire existe donc rien a faire
Else: fs.CreateFolder chemin ' le repertoire n'existe pas donc on le créer
End If
Set fs = Nothing
End Sub
Sub enregistrer()
'
' enregistrer Macro
'
' boite dialogue dossier enregistrement
'
nomdossier = Application.InputBox(prompt:="ENTREZ ANNEE?", Type:=2)
dossier = "C:\Locations\" & nomdossier & "\"
test_repertoire (dossier)
'exportation en pdf sous forme facture_n°_client.pdf
Sheets("Factures").Select
Range("A1:H44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$44"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
dossier & Range("F10").Value & "_" & "Facture_" & Range("C10") & "_" & Range("E2").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Sheets("Factures").Select
Range("A1:C1").Select
End Sub
bonjour à toutes et tous
bonjour Fred2406
désolé de répondre tardivement ....problème de santé me concernant
je vais tester le code et je vous tiens au courant
Merci pour votre aide
re bonjour,
bon j'ai essayer la fonction j'ai une erreur lors de l'exportation en pdf
je pense que j'ai fait une erreur lors de l'incorporation du code mais je ne vois trop où
voici la macro avec le code incorporé
Sub enregistrer()
'
' enregistrer Macro
'
' boite dialogue dossier enregistrement
'
nomdossier = Application.InputBox(prompt:="ENTREZ ANNEE?", Type:=2)
dossier = "C:\Locations\" & nomdossier & "\"
'test si dossier existe sinon création
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject") ' initialisation de la variable
If fs.FolderExists(C:\Locations\) Then ' le repertoire existe donc rien a faire
Else: fs.CreateFolder C:\Locations\ ' le repertoire n'existe pas donc on le créer
End If
Set fs = Nothing
'exportation en pdf sous forme facture_n°_client.pdf
Sheets("Factures").Select
Range("A1:H44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$44"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
dossier & Range("F10").Value & "_" & "Facture_" & Range("C10") & "_" & Range("E2").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Sheets("Factures").Select
Range("A1:C1").Select
End Sub
bonjour
pourquoi ne pas laissé le code comme je l'ai fournit ?
voici le code complet a mettre dans un module
Fred
Sub enregistrer()
'
' enregistrer Macro
'
' boite dialogue dossier enregistrement
'
nomdossier = Application.InputBox(prompt:="ENTREZ ANNEE?", Type:=2)
dossier = "C:\Locations\" & nomdossier & "\"
test_repertoire (dossier)
'exportation en pdf sous forme facture_n°_client.pdf
Sheets("Factures").Select
Range("A1:H44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$H$44"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
dossier & Range("F10").Value & "_" & "Facture_" & Range("C10") & "_" & Range("E2").Value & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Sheets("Factures").Select
Range("A1:C1").Select
End Sub
Sub test_repertoire(chemin As String)
Dim fs As object
Set fs = CreateObject("Scripting.FileSystemObject") ' initialisation de la variable
If fs.FolderExists(chemin) Then ' le repertoire existe donc rien a faire
Else: fs.CreateFolder chemin ' le repertoire n'existe pas donc on le créer
End If
Set fs = Nothing
End Sub
re
question on est sur que le dossier "C:\Locations\" existe ou pas ???
sinon la vérification du dossier renseigné par msgbox est faite ici :
dossier = "C:\Locations\" & nomdossier & "\"
test_repertoire (dossier)
essai d’exécuter le programme en mode pas a pas pour vérifier le fonctionnement
car cela fonctione chez moi....
fred
re
oui le dossier "c:\Locations" existe bien
car quand j'exécute la macro sans ton bout de code la feuille est sauvegarder en pdf dans le dossier que l'on me demande de rentrer
je vais essayer de faire un pas a pas
je te tiens au courant
re
ça y est j'ai trouvé d'où cela venait.
j'avais oublié un bout de ton code en copiant collant
tu es un dieu
merci pour aide cela fonctionne nickel
je passe le sujet en résolu
Bonjour à vous tous
S'il vous plait, pourtant que j'ai essayé de suivre les solutions que vous avez partagé , j'arrive pas à gerer les dossier via VBA pour un sauvegarde de fichier dans un chemin relatif ou absolu
Est ce que vous pouvez me donner un coup de main ?
ce qui suit est mon code actuel, via lequel je sauvegarde mes rapports sur mon PC et ça fonctionne tres bien, sauf qu'en donnant le fichier à mes collègues, il y a erreur de chemin, car le mien est absolut
ChDir "C:\Users\DeptLog\Desktop\gestion de production\rapport du jour"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\DeptLog\Desktop\gestion de production\rapport du jour\RAPPORT_de_PRODUCTION_pour " & Format(Date, "dd-mm-yyyy") _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
ce que je cherche est d'avoir un code qui me permet la liste suivante des tâches:
1-Verification de l'existance du dossier ayant le chemin suivant: bureau de l' utilisateur en cours idépendamment du nom de son ordinateur/gestion de production/rapport du jour
2- si le dossier existe, donc il enregistre le fichier PDF, sinon il le crée puis enregistre le fichier PDF
voilà le code que j'ai essayé , mais toujour des erreurs de compilation:
Dim GestionFichier As New Scripting.FileSystemObject
If GestionFichier.FolderExists("C:\Users\Public\Desktop\gestion de production\rapport du jour") = False Then
GestionFichier.CreateFolder "C:\Users\Public\Desktop\gestion de production\rapport du jour"
End If
Set GestionFichier = Nothing
Erreur de compilation: Type Défini par l'utilisateur non défini
Comment Faire SVP ?
Merci
mon support en ligne pour Gestion des fichiers, dossiers et lecteurs: http://www.info-3000.com/vbvba/fichiers/index.php#ExistenceDossier
J'ai réussi à trouver la bonne solution, pourtant que je pense lourde en terme de complexité processeur
j'ai essayé de commenter tout le code pour plus de lisibilité
Public Function DossierExiste(MonDossier As String)
'Fonction publique pour Tester si le dossier Existe ou non, si oui retours True, sinon retous False
'fonction publique à utiliser apres de la part de sub "Bouton149_Cliquer()
If Len(Dir(MonDossier, vbDirectory)) > 0 Then
DossierExiste = True
Else
DossierExiste = False
End If
End Function
Sub Bouton149_Cliquer()
Dim MonDossier As String
' pour recuperer le nom de l'utilisateur en cours et garantir la portabilité du code
NomDuPC_UtilisateurEnCours = Application.UserName
'definir le chemin de sauvegarde, chemin absolut
MonDossier = "C:\Users\" & NomDuPC_UtilisateurEnCours & "\Desktop\AtelierChafaa"
' si le dossier existe déjà donc exporter le fichier PDF avec les paramètres dates etc...
If DossierExiste(MonDossier) = True Then
'MsgBox "Le dossier existe..."
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
(MonDossier) & "\RAPPORT_de_PRODUCTION_pour " & Format(Date, "dd-mm-yyyy") _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
'ouvrir le dossier de sauvegarde du fichier PDF avec l'explorateur windows
Shell Environ("WINDIR") & "\explorer.exe " & MonDossier, vbNormalFocus
Else
'MsgBox "Le dossier n'existe pas..."
'si le dossier n'existe pas, donc le créer dans le chemin absolut adapté au nom d'utilisateur en cours
MkDir "C:\Users\" & NomDuPC_UtilisateurEnCours & "\Desktop\AtelierChafaa"
'apres avoir créer le dossier, exporter le fichier PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
(MonDossier) & "\RAPPORT_de_PRODUCTION_pour " & Format(Date, "dd-mm-yyyy") _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
'ouvrir le dossier de sauvegarde du fichier PDF avec l'explorateur windows
Shell Environ("WINDIR") & "\explorer.exe " & MonDossier, vbNormalFocus
'Le paramètre vbNormalFocus ouvre le dossier dans une fenêtre normale qui sera active. Selon votre besoin, vous pouvez le remplacer par:
'vbNormalNoFocus (taille normale, fenêtre pas active)
'vbMaximizedFocus (taille maximisée, fenêtre active)
'vbMinimizedFocus (taille minimisée, affichée comme une icône active)
'vbMinimizedNoFocus (taille minimisée, affichée comme une icône inactive)
'créer un sous-dossier , car MKDIR ne permet pas la création d'arbiressance directement de plusieurs niveau
MkDir "C:\Users\" & NomDuPC_UtilisateurEnCours & "\Desktop\AtelierChafaa\chafaa"
End If
End Sub
bonjour Sgh.Chafaa
il aurait été plus simple de créer un nouveau sujet... plutôt que de reprendre un sujet d'une autre personne....
de plus inutile de m'envoyer 2 privés supplémentaires....
perso j'ai pas tout compris a ta demande... mais
1° si tu es utilisateur de ta machine tu ne pourras probablement pas écrire dans le bureau des allusers.... seulement de l'utilisateur connecté
2° suivant tes lignes de codes tu veux comme chemin :
"\Desktop\AtelierChafaa
ou
\Desktop\gestion de production\rapport du jour\
faut savoir.....
si dessous une proposition pour le second chemin...je te laisse corriger les noms des dossiers si necessaire...
fred
Sub enregistre()
Dim DD As String
'vérification que le dossier gestion de production existe sinon creation
DD = Environ("USERPROFILE") & "\desktop\gestion de production\"
If Dir(DD, vbDirectory) = "" Then MkDir DD
'vérification que le sous dossier rapport du jour existe sinon creation
DD = DD & "\rapport du jour\"
If Dir(DD, vbDirectory) = "" Then MkDir DD
'export pdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DD & "RAPPORT_de_PRODUCTION_pour " & Format(Date, "dd-mm-yyyy") & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub
J'ai pensé qu’éviter la création d'un nouveau sujet et plus simple en terme de recherche pour les internautes sur google ( un seul sujet dans lequel il y a toutes les solutions possibles) sera plus efficace
Bref
autre solution par rapport à celle que j'ai trouvé hier, mais la tienne beaucoup plus simple
Merciii ^^