XL 2016 Aide sur sauvegarde

[tinet]

Bonjour le forum,

Voici ma demande, Je ne sais pas si ceci est réalisable.
Mais je tente.

J'ai un code pour sauvegarder mes présentations de page Excel en PDF dans le répertoire racines de mon fichier.
Comme je vais avoir de nombreuses pages à sauvegardées je voudrais créer des répertoires automatiques

Exemple:
Ma valeur de référence serait DA en M8
M8 Serait = à 1
Trouver une solution pour que le dossier crée un sou répertoire
Dossier = "Mars \1\"

puis

Ma valeur de référence serait DA en M8
M8 Serait = à 2
Trouver une solution pour que le dossier crée un sou répertoire
Dossier = "Mars \2\"

Et ainsi de suite

Merci pour votre aide

Sub PDF()


    chemin = Workbooks(ActiveWorkbook.Name).Path
    Feuille = ActiveSheet.Name
    
    Dossier = "Mars \"

    fa = Format([M1], " dd mmm")
    d = Range("M2").Value
    s = Range("M3").Value
    t = Range("M4").Value
    
    nomFichier = "" & s & fa & "" & "    " & d & "  " & t & ".pdf"

    If Dir(chemin & "\" & Dossier) = "" Then
        On Error Resume Next
        MkDir chemin & "\" & Dossier
        On Error GoTo 0
    End If

    CheminEvent = chemin & "\" & Dossier
  

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                    CheminEvent & "\" & nomFichier, Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                                    False
   
    End Sub

 

[GALOUGALOU]

bonsoir tinet bonsoir le forum
vous avez dejà bien maitrisé
ci dessous une macro qui incrémente un compteur sur la cellule m8 (la msgbox est à supprimer)
a vous d’adapter dans vote macro

Sub compteur()
Dim compteur As Integer
compteur = Range("M8").Value
MsgBox compteur
Range("M8").Value = compteur + 1
End Sub

cordialement
galougalou

 

[tinet]

Bonjour Galougalou,

Ce n'est pas ma demande