Ouvrir un sous dossier en fonction d'une date

Bonjour

Je cherche à enregistrer un devis dans un sous dossier

J'arrive à ouvrir mes sous dossier par l'intermediaire de ce chemin

ChDir "C:\Users\Utilisateur\Desktop\*********\***********\DEVIS"

et j'arrive sur mes 12 sous dossiers mois qui ce compose du dossier Janvier, Février, Mars et ainsi de suite pour les douze mois.

Pour l'instant, je suis obligé de sélectionner le mois que je désire, l'ouvrir et enregistrer mon classeur.

Ce que je souhaiterais c'est que le dossier du mois s'ouvre tout seul en fonction de la date de mon devis de façon à ne plus avoir qu'à l'enregistrer.

Ma date se trouve sur la cellule ("E2:F2") car elle est fusionnée.

Pour l'instant elle est au format 01/01/2021, mais peut passer au format 01 janvier 2021.

Si quelqu'un peut me trouver une solution.

En vous remerciant.

Bien cordialement

Bonjour bejouette,

voici ma proposition

Sub test()
'https://forum.excel-pratique.com/excel/ouvrir-un-sous-dossier-en-fonction-d-une-date-158714

      Dim MonFichier As Variant
      Dim StartDir As String, Mois As String

      Mois = StrConv(Format(ActiveSheet.Range("E2"), "mmmm"), vbProperCase)

      StartDir = CurDir
      ChDir "C:\Users\Utilisateur\Desktop\*********\***********\DEVIS\" & Mois

      MonFichier = Application.GetOpenFilename(MultiSelect:=False)

    ChDir StartDir
End Sub

Bonjour,

En vous remerciant de vous être intéressé à ma demande.

Est ce qu'il y a quelque chose à modifier à votre proposition à part mon chemin?

Il y a blocage sur le chemin

Erreur exécution'76'

Chemin d'accès introuvable

Bonne réception

Bonjour,

à verifier le le caractère \ après le mot DEVIS

Re

Pour moi c'est tout bon si je n'ai que mon chemin à remettre sans absolument rien toucher à votre formule

Re

Je fais tous mes essais sur le mois de février.

J'aurai pu prendre un autre mois mais c'est comme cela.

J'ai repris un autre classeur pour faire un essai sur un chemin beaucoup plus court et avec une seule feuille et me suis remis dans le même contexte que mon classeur d'origine

Sur ce nouveau dossier j'ai mis le sous dossier janvier ET LUI PASSE.

Aussitôt je me suis dit cela venait de mon chemin.

J'ai donc crée février et là, il ne passe pas. J'ai donc créer tous les mois et il s'avère que cela fonctionne pour tous les mois sauf FEVRIER, AOUT ET DECEMBRE.

Ce sont les seuls mois ou il y a un accent.

Si jamais vous aviez la solution pour ces trois mois, est ce que vous pourriez m'indiquer comment il faut faire pour enregistrer mon classeur car votre macro est "FIGER" sur ouvrir (ce qui est très bien car le mois est bien ouvert) mais après, il faudrait que mon classeur vienne se mettre dans ce dossier ET AVOIR LE BOUTON ENREGISTRER.

Bonne réception.

Bonjour

Je viens d'essayer ce matin en mettant le e accent aigu sur les mois de fevrier, decembre et accent circonflexe sur aout et cela fonctionne.

Il ne manque plus que l'option ENREGISTRER au lieu d'ouvrir et normalement cela sera tout bon.

Bonne journée.

Bonjour bejouette,

un exemple à tester, le fichier est enregistré avec seulement la feuille active, le nom de la feuille et au format xlsx (sans macro), les deux paramètres peuvent être modifiés

Sub test2()

    Dim MonFichier As Variant
    Dim StartDir As String, Mois As String

    Mois = StrConv(Format(ActiveSheet.Range("E2"), "mmmm"), vbProperCase)

    StartDir = CurDir

    ChDir "C:\Users\Sequoyah\Desktop\Forum\2021\" & Mois ' <<=== CHEMIN à adapter

    Application.ScreenUpdating = False

    ActiveSheet.Copy

    With ActiveWorkbook

        MonFichier = Application.GetSaveAsFilename(InitialFileName:=ActiveSheet.Name, _
                     fileFilter:="Fichier Excel (*.xls*), *.xls*", _
                     Title:="Enregistrer le devis")

        If MonFichier = False Then
            .Close SaveChanges:=False
        Else
            .SaveAs FileName:=MonFichier & "xlsx", FileFormat:=51
            .Close SaveChanges:=False
        End If

    End With

    ChDir StartDir
    Application.ScreenUpdating = True

End Sub

Cordialement

Rebonjour

SUPER

Impeccable, génial

Cela sera plus pratique pour moi.

En vous remerciant.

Bien cordialement.