Verifier existance dossier sinon le créer Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
t
tchancayre
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 6 septembre 2016
Version d'Excel : 2013 Fr

Message par tchancayre » 7 octobre 2016, 08:50

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
Gestion Locations.xlsm
(62.74 Kio) Téléchargé 26 fois
Gestion Locations.xlsm
(71.59 Kio) Téléchargé 55 fois
Modifié en dernier par tchancayre le 8 octobre 2016, 12:18, modifié 1 fois.
Avatar du membre
fred2406
Membre impliqué
Membre impliqué
Messages : 2'059
Appréciations reçues : 37
Inscrit le : 13 mai 2014
Version d'Excel : O365Pro-2019-2011MAC
Version de Calc : 6.3

Message par fred2406 » 7 octobre 2016, 09:08

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 & "\"
[surligner]test_repertoire (dossier)[/surligner]
'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
Je ne réponds pas aux M.P. non sollicités.
Ne pas oublier :
:btres:
Fred :O-O:
t
tchancayre
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 6 septembre 2016
Version d'Excel : 2013 Fr

Message par tchancayre » 8 octobre 2016, 08:38

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
t
tchancayre
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 6 septembre 2016
Version d'Excel : 2013 Fr

Message par tchancayre » 8 octobre 2016, 09:24

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
Avatar du membre
fred2406
Membre impliqué
Membre impliqué
Messages : 2'059
Appréciations reçues : 37
Inscrit le : 13 mai 2014
Version d'Excel : O365Pro-2019-2011MAC
Version de Calc : 6.3

Message par fred2406 » 8 octobre 2016, 09:38

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
Je ne réponds pas aux M.P. non sollicités.
Ne pas oublier :
:btres:
Fred :O-O:
t
tchancayre
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 6 septembre 2016
Version d'Excel : 2013 Fr

Message par tchancayre » 8 octobre 2016, 10:37

Rebonjour fred2406

j'ai mis ton code dans la macro comme tu me l'as indiqué mais j'ai la même erreur

sans le code cela fonctionne bien mais je n'ai pas de vérification d'existence du dossier
2016-10-08_103400.jpg
Avatar du membre
fred2406
Membre impliqué
Membre impliqué
Messages : 2'059
Appréciations reçues : 37
Inscrit le : 13 mai 2014
Version d'Excel : O365Pro-2019-2011MAC
Version de Calc : 6.3

Message par fred2406 » 8 octobre 2016, 11:58

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
Je ne réponds pas aux M.P. non sollicités.
Ne pas oublier :
:btres:
Fred :O-O:
t
tchancayre
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 6 septembre 2016
Version d'Excel : 2013 Fr

Message par tchancayre » 8 octobre 2016, 12:04

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 :clap: :sp:
je passe le sujet en résolu
S
Sgh.Chafaa
Jeune membre
Jeune membre
Messages : 46
Appréciations reçues : 2
Inscrit le : 26 octobre 2017
Version d'Excel : 2010

Message par Sgh.Chafaa » 30 janvier 2018, 23:44

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 ... nceDossier
S
Sgh.Chafaa
Jeune membre
Jeune membre
Messages : 46
Appréciations reçues : 2
Inscrit le : 26 octobre 2017
Version d'Excel : 2010

Message par Sgh.Chafaa » 31 janvier 2018, 00:48

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
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message