Enregistrement en macro en pdf en créant un nouveau dossier

Bonjour à vous

J'ai une petite question à vous demander !

J'ai actuellement cette macro qui fonctionne très bien pour enregistrer un pdf (dans le dossier où est enregistré le fichier Excel) :

Sub pdf()

Dim Ar(2) As String

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B7").Value & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

End Sub

Cependant, concernant l'enregistrement dans le répertoire j'aimerai :

• que la macro crée un dossier en le nommant "donnees"
• À l'intérieur de celui-là, il faut que la macro crée un sous-dossier avec un nom qui dépend du texte présent dans une cellule (exemple : "validation 2016-12-07")
• Puis encore à l'intérieur de ce sous-dossier, créer un dossier avec un nom défini "extraction"
• Il faut bien entendu que la macro ne crée aucun dossier ou de sous-dossier s'il existe déjà bien évidemment

Pour simplifier : la macro enregistre le pdf dans l'arborescence suivant : Dans le dossier actuel du fichier Excel (qui peut être déplacé) il y a un dossier nommé "donnees". À l'intérieur il faut créer un dossier qui se nomme avec la date du jour "validation 2016-12-07" puis un autre sous-dossier avec un nom défini (exemple "extraction").

Je sais que c'est techniquement faisable, mais... je sèche !

Avez-vous une solution ?

En vous remerciant,

Nicolas

Bonjour,

un petit coup d’œil aux liens suivant et ton problème est résolu !

http://excel-malin.com/codes-sources-vba/vba-verifier-si-dossier-existe/

http://excel-malin.com/codes-sources-vba/creation-dossiers-et-sous-dossiers-en-vba/

A ta disposition si tu as besoin de plus d'infos

A plus.

Merci pour ta réponse

Je sèche par contre pour réunir les liens que tu m'as communiqués afin que ça réalise le tout.

Est-ce que c'est faisable ce mix ?

Merci en tout cas pour ta réponse !

Voici un code à tester, en pensant à modifier le chemin du premier dossier (Celui de "Donnees") que je considère comme étant déjà créée :

Public Function DossierExiste(MonDossier As String)

   If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function

Sub TesteSiDossierExiste()

Dim MonDossier As String

MonDossier = "C:\...\Donnees\Validation" & Day(Date) & "." & Month(Date) & "." & Year(Date)

    If DossierExiste(MonDossier) = True Then

        MkDir ("C:\...\Donnees\Validation" & Date & "\Extraction")

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B7").Value & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

    Else

        MkDir ("C:\...\Donnees\Validation" & Day(Date) & "." & Month(Date) & "." & Year(Date))
        MkDir ("C:\...\Donnees\Validation" & Day(Date) & "." & Month(Date) & "." & Year(Date) & "\Extraction")

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B7").Value & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

    End If

End Sub

bonsoir a vous

voici un code qui permet d'enregistrer en .pdf dans un dossier qu'il créer en même temps avec le nom du mois et les derniers chiffres de l'année en cours,si le dossier n'existe pas,il le créer et créer un dossier a chaque changement de mois mais le dossier créer reste actif le mois durant

    Private Sub CommandButton1_Click()
      Application.DisplayAlerts = False
      Dim Chemin As String, Fichier As String, Rep As String
      Chemin = "C:\Users\vous-même\Desktop\Nouveau dossier\"'======chemin a changer
     'Chemin = ThisWorkbook.Path & "\"
     'créer un dosier avec le nom du mois et l'année en cours
     'si le mois change un autre dossier est créer
      Rep = Application.Proper(MonthName(Month(Date))) & " " & Year(Date)
      'gestion des erreurs
      On Error Resume Next
      'définition du chemin
      MkDir Chemin & Rep
      On Error GoTo 0
      Chemin = Chemin & Rep & "\"
      Sheets("Feuil1").Copy
      'copie de la feuille en ajoutant F devant le n° qui est en "C4" et +la date
      Fichier = Sheets("Feuil1").Range("C4") & " " & "F" & Format(Date, "ddmmyyyy") & ".Pdf"
      With ActiveWorkbook
      'code qui enregistre en .pdf
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & Fichier, Quality:=xlQualityStandard, _
                              IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                              From:=1, To:=1, OpenAfterPublish:=False
        'ferme le classeur créer
       .Close savechanges:=False
       'retabli les arlertes windows
        Application.DisplayAlerts = True
        'message pour dire que le fichier a bien été enregistrer
        'que le chemin est bon
        MsgBox ("Enregistré dans le dossier -Factures-")
      End With
    End Sub