XL 2021 Comment créer un code VBA afin de création un chemin d'accès universel

AugusteP

AugusteP

XLDnaute Nouveau
Bonjour,

J'essai de créer un code VBA me permettant d'obtenir pour chaque utilisateur le même chemin dossier après enregistrement.
Le dossier où est enregistrée l'application sera enregistré sur le bureau de chaque ordi. De plus, dans ce dossier il y aura un sous-dossier appelé commande client. Ce que je cherche à faire c'est créer un chemin dossier universel utilisable par tout le monde. Pour le moment cela fonctionne mais avec un chemin propre à mon ordi.
Merci me m'apporter votre aide
Ci-dessous mes lignes de code
Cordialement


Private Sub EnregistrementBCde_Click()

'Déclaration des variables

Dim CheminDossier As String
Dim CheminsousDossier As String
Dim Commande As String
Dim Li As Byte

On Error GoTo 1

'Nom de dossier
CheminDossier = "C:\Users\beaud\OneDrive\Bureau\Application en cours de modif\Commande client\" '.................Chemin pour création du dossier
CheminsousDossier = CheminDossier & Me.LbNomClient & "\" '.....nom du sous dossier
Call test_repertoire(CheminsousDossier) '....créer un sous-dossier client s'il n'existe pas
Commande = Me.LbNomClient & " Commande client N° " & Me.Txtnumcde & " du " & Format(Date, "dd-mm-yyyy") & ".pdf" '...............Références de la commande à sauvegarder

If Me.LbNomClient = "" Then
Me.LbNomClient.SetFocus
Exit Sub
End If
Call test_repertoire(CheminDossier) '...................................................................vers procédure Test_repertoire (si le dossier n'existe pas il est créé)
'Enregistrement au format PDF
Application.ScreenUpdating = False '....................................................................désactivation de la mise à jour écran
Sheets("Cde client").ExportAsFixedFormat Type:=xlTypePDF, Filename:=CheminsousDossier & Commande, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, OpenAfterPublish:=False '................................sauvegarde du fichier au format pdf
Application.ScreenUpdating = True '.....................................................................réactivation de l'écran

Exit Sub

'Le traitement de l'erreur se p1ace en dessous d'un exit sub juste avant le end sub
1:
MsgBox "Erreur de traitement, sortie de formulaire"
Application.ScreenUpdating = True
End Sub
Sub test_repertoire(CheminDossier As String)
'
'*************************************************************************************
' fonctionne en lien avec la procédure Private Sub EnregistrementBCde_Click() *
'*************************************************************************************
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject") '................instanciation de la variable fs
If fs.FolderExists(CheminDossier) Then '.............................le repertoire existe donc rien à faire
Else: fs.CreateFolder CheminDossier '...................................le repertoire n'existe pas donc on le créait
End If
Set fs = Nothing '...................................................vide l'instanciation fs
End Sub
 
Trier par date Trier par votes
fanch55

fanch55

XLDnaute Barbatruc
Bonsoir,
A main levé, à tester si cela répond à votre demande :
VB: 
Sub EnregistrementBCde_Click()

'Déclaration des variables

Dim Dossier     As String
Dim SubDir      As String
Dim Fso         As Object

    If Me.LbNomClient = "" Then
        Me.LbNomClient.SetFocus
    Else
        ' Création des subdirectories si nécessaire
        Dossier = CreateObject("WScript.Shell").specialFolders("Desktop")
        Set Fso = CreateObject("Scripting.FileSystemObject")
            For Each SubDir In Array("Application en cours de modif", "Commande client", Me.LbNomClient)
                Dossier = Dossier & "\" & SubDir
                If Not Fso.FolderExists(Dossier) Then Fso.CreateFolder Dossier
            Next
        Set Fso = Nothing
       ' Sauvegarde du fichier au format pdf .........................
        Commande = Me.LbNomClient & " Commande client N° " & Me.Txtnumcde & " du " & Format(Date, "dd-mm-yyyy") & ".pdf" '...............Références de la commande à sauvegarder
        Sheets("Cde client").ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Dossier & "\" & Commande, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, OpenAfterPublish:=False
    End If

End Sub
 
Vote positif 0 Vote négatif
AugusteP

AugusteP

XLDnaute Nouveau
fanch55 à dit:
Bonsoir,
A main levé, à tester si cela répond à votre demande :
VB: 
Sub EnregistrementBCde_Click()

'Déclaration des variables

Dim Dossier     As String
Dim SubDir      As String
Dim Fso         As Object

    If Me.LbNomClient = "" Then
        Me.LbNomClient.SetFocus
    Else
        ' Création des subdirectories si nécessaire
        Dossier = CreateObject("WScript.Shell").specialFolders("Desktop")
        Set Fso = CreateObject("Scripting.FileSystemObject")
            For Each SubDir In Array("Application en cours de modif", "Commande client", Me.LbNomClient)
                Dossier = Dossier & "\" & SubDir
                If Not Fso.FolderExists(Dossier) Then Fso.CreateFolder Dossier
            Next
        Set Fso = Nothing
       ' Sauvegarde du fichier au format pdf .........................
        Commande = Me.LbNomClient & " Commande client N° " & Me.Txtnumcde & " du " & Format(Date, "dd-mm-yyyy") & ".pdf" '...............Références de la commande à sauvegarder
        Sheets("Cde client").ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Dossier & "\" & Commande, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, OpenAfterPublish:=False
    End If

End Sub
Cliquez pour agrandir...
Bonjour, merci pour votre aide cependant un message d'erreur s'affiche concernant la variable de contrôle for each
1684551631096.png
 
Vote positif 0 Vote négatif
AugusteP

AugusteP

XLDnaute Nouveau
AugusteP à dit:
Bonjour, merci pour votre aide cependant un message d'erreur s'affiche concernant la variable de contrôle for each
Regarde la pièce jointe 1170509
Cliquez pour agrandir...
Re bonjour,

Je viens de changer mon chemin dossier et cela fonctionne, ci-dessous ma correction.

CheminDossier = Environ("userprofile") & "\OneDrive\Bureau\Application en cours de modif\Commande client\" '.................Chemin pour création du dossier

Merci et bonne journée
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
301
firecarl
F
M
  • Question
XL 2013 MACRO VBA pour imprimer tous les bulletins d'un établissement scolaire
Réponses
4
Affichages
223
MBEPID
M
AugusteP
  • Question
XL 2021 Ouverture d'un PDF à l'aide d'un bouton clic et pour multi utilisateur PC
Réponses
3
Affichages
414
AugusteP
AugusteP
M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
312
MarineU
M
chris6999
  • Question
Microsoft 365 Conserver la valeur de ma variable pour l'utiliser dans un autre code
Réponses
3
Affichages
322
mapomme
mapomme
AugusteP
  • Question
XL 2021 comment convertir et enregistrer en pdf tout en conservant la date d'une textbox vba
Réponses
2
Affichages
466
AugusteP
AugusteP
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
483
job75
job75
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
410
loreak
L
J
  • Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
61
JJ69
J
C
  • Résolu(e)
XL 2021 Sauvegarder répertoire/sous répertoire un peu volumineux 2 Go
Réponses
7
Affichages
186
Claudinedu13
C

Membres actuellement en ligne

3 membres et 44 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 097
Messages
2 116 186
Membres
112 679
dernier inscrit
Yupanki