XL pour MAC création d'un dossier et enregistrement d'un fichier en pdf

tdenis

XLDnaute Nouveau
Bonjour La communauté ,
voila mon petit soucis de code :
je souhaite enregistrer un fichier(feuille active) ennemi format pdf dans un répertoire précis et de créer un dossier au nom du client.
Pouvez m'éclairer sur le code ci-dessous car j'ai bien la création du dossier er cela me l'enregistre dans le dossier parent et non dans le dossier du client...
si mon dossier parent est crée, je lu demande d'enregistrer simplement dans le dossier parent .. c'est les erreurs 75 du code
Je vous remercie pour votre aide.
Excelemment votre
Tdenis
VB:
Sub TesteDossierExiste()
 Dim MonDossier As String
 Dim Monfichier As String
 Dim SousDossier As String
 Dim DossierCree As String
MonDossier = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/"
DossierCree = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/" & SousDossier
Monfichier = Range("L1").Value
SousDossier = Range("F4").Value
If Len(Dir(("/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/") & SousDossier)) = True Then
    
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
     DossierCree & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    MsgBox ("Le fichier " & Monfichier & " est bien enregistré ")
      
   Else
   MkDir ("/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/") & SousDossier
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
    Dir("/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/") & SousDossier & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    
    MsgBox ("Le dossier " & SousDossier & "  et  Le fichier " & Monfichier & " ont bien été crée et enregistré ")

      
    
   End If
        
  
End Sub
 
Solution
Bonsoir à tous,
j'ai enfin trouvé mes petits soucis de chemin..
donc voici le code final et cela fonctionne
merci a tous pour vos réponses et orientations.
VB:
Sub TesteDossierExiste()
 Dim MonDossier As String
 Dim Monfichier As String
 Dim SousDossier As String
 Dim DossierCree As String
MonDossier = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/"
Monfichier = Range("L1").Value
SousDossier = Range("F4").Value
DossierCree = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/" & SousDossier & "/"
On Error Resume Next
ChDir MonDossier & SousDossier
If Err <> 0 Then
   MkDir MonDossier & SousDossier
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
   DossierCree & Monfichier, _...

justvicto

XLDnaute Nouveau
Je te conseille ce code qui marche parfaitement bien pour ma part !


VB:
Sub Exporte()
Dim NomFichier As Variant

ChDir ThisWorkbook.Path
    Sheets("pp").Select 'A REMPLACER POUR TOI
    NomFichier = Application.GetSaveAsFilename(fileFilter:="PDF (*.pdf), *.pdf")
    If NomFichier <> False Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                        Filename:=NomFichier, _
                                        Quality:=xlQualityStandard, _
                                        IncludeDocProperties:=True, _
                                        IgnorePrintAreas:=False, _
                                        OpenAfterPublish:=False
    End If

End Sub
 

job75

XLDnaute Barbatruc
Concernant le code du post #1 :
VB:
If Len(Dir(("/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/") & SousDossier)) = True Then
ne va pas puisque LEN(xxx) n'est jamais égal à True (qui vaut -1).

Il suffit d'enlever =True :
VB:
If Len(Dir("/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/" & SousDossier)) Then
 

tdenis

XLDnaute Nouveau
Re,
Merci beaucoup pour vos réponses ;)
Après l'essai de vos codes, je vous explique les erreurs.
Dans le premier cas : les dossiers n'existent pas et fichier non enregistré en pdf dans le dossier
- je valide enregistrer et le résultat est : Dossier au nom du client crée au bon endroit, et mon fichier en pdf crée mais dans le dossier parent ... et non le sous dossier au nom du client
lorsque le dossier est crée auparavant soit par un autre devis du même nom de client soit une création de facture. résultat erreur 75 en sur lignage sur le Mkdir
VB:
Sub TesteDossierExiste()
 Dim MonDossier As String
 Dim Monfichier As String
 Dim SousDossier As String
 Dim DossierCree As String
MonDossier = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/"
DossierCree = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/" & SousDossier
Monfichier = Range("L1").Value
SousDossier = Range("F4").Value
If Len(Dir("/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/" & SousDossier)) Then
    
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
     DossierCree & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    MsgBox ("Le fichier " & Monfichier & " est bien enregistré ")
      
   Else
   ' erreur 75 sur la ligne en dessous
   MkDir ("/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/") & SousDossier
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
    DossierCree & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    
    MsgBox ("Le dossier " & SousDossier & "  et  Le fichier " & Monfichier & " ont bien été crée et enregistré ")

      
    
   End If
        
  
End Sub
a vous lire et bonne soirée
Tdenis
 

job75

XLDnaute Barbatruc
Vous avez créé la variable MonDossier, pourquoi vous ne vous en servez pas ensuite ?

Quant à MkDir il beugue si le sous-dossier a déjà été créé, il faut donc tester son existence :
VB:
If Dir(MonDossier & SousDossier, vbDirectory) = "" Then MkDir MonDossier & SousDossier
 

tdenis

XLDnaute Nouveau
Bonjour Job75,
j'ai modifié un peu mon code sur le MKdir et cela fonction pour la création de dossier et ne beugue pas s'il existe...ouf
Maintenant je n'arrive a desseller le problème de chemin d'enregistrement du fichier ...
soit il ne m'enregistre pas le fichier après avoir créer le dossier : première condition après le If ou soit il enregistre dans le dossier parent avec le nom en double ...
Merci de m'éclairer
et merci pour vos réponses d'hier
belle journée a vous
Thierry

VB:
Sub TesteDossierExiste()
 Dim MonDossier As String
 Dim Monfichier As String
 Dim SousDossier As String
 Dim DossierCree As String
MonDossier = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/"
Monfichier = Range("L1").Value
SousDossier = Range("F4").Value
DossierCree = MonDossier & SousDossier
On Error Resume Next
ChDir MonDossier & SousDossier
If Err <> 0 Then
   MkDir MonDossier & SousDossier
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
   MonDossier / SousDossier & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    
    MsgBox ("Le dossier " & SousDossier & "  et  Le fichier " & Monfichier & " ont bien été crée et enregistré ")
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
     MonDossier & SousDossier & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    MsgBox ("Le fichier " & Monfichier & " est bien enregistré ")
      
    
   End If
        
  
End Sub
 

Pièces jointes

  • Capture d’écran 2021-03-09 à 09.11.28.png
    Capture d’écran 2021-03-09 à 09.11.28.png
    57.9 KB · Affichages: 8

tdenis

XLDnaute Nouveau
Bonsoir à tous,
j'ai enfin trouvé mes petits soucis de chemin..
donc voici le code final et cela fonctionne
merci a tous pour vos réponses et orientations.
VB:
Sub TesteDossierExiste()
 Dim MonDossier As String
 Dim Monfichier As String
 Dim SousDossier As String
 Dim DossierCree As String
MonDossier = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/"
Monfichier = Range("L1").Value
SousDossier = Range("F4").Value
DossierCree = "/Users/thierrydenis/Documents/Micro entreprise Menuiserie/CLIENTS/" & SousDossier & "/"
On Error Resume Next
ChDir MonDossier & SousDossier
If Err <> 0 Then
   MkDir MonDossier & SousDossier
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
   DossierCree & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    
    MsgBox ("Le dossier " & SousDossier & "  et  Le fichier " & Monfichier & " ont bien été crée et enregistré ")
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
     DossierCree & Monfichier, _
    Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    MsgBox ("Le fichier " & Monfichier & " est bien enregistré ")
      
    
   End If
        
 
End Sub
 

Discussions similaires

Réponses
2
Affichages
141
Haut Bas