[RESOLU]Creer classeur depuis valeur

[hypo78]

Bonjour,
Grace à votre aide, j'ai une macro qui fonctionne bien me permettant de créer un dossier puis un classeur nommé en fonction d'une date saisie.
la macro :

Sub Creation_classeur_nommé()
DateDeSaisie = Range("b8")
Workbooks.Open Filename:="F:\Data\Feuilles de garde\Versaillesbis\modèle_VRS.xls"
ActiveWorkbook.Sheets("01").Select
Range("AK1") = DateDeSaisie
If Dir(ActiveWorkbook.Path & "\" & Format(DateDeSaisie, "mmmmyyyy"), vbDirectory) = "" Then MkDir ActiveWorkbook.Path & "\" & Format(DateDeSaisie, "mmmmyyyy")
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & Format(DateDeSaisie, "mmmmyyyy") & "\" & Format(DateDeSaisie, "ddmmmmyyyy") & ".xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub

J'aimerai, sur le même principe créer mes classeurs pour une année complète (12 dossiers/30 à 31 classeurs par dossiers).

Comment faire pour que la date choisie soit incrémenter de 1 jour et que la macro tourne sur 365 jours?

Merci d'avance

 

[hypo78]

Re : Creer classeur depuis valeur

Çà fonctionne pour créer les 365 jours, par contre les dossiers sont nommés 1,2,3... et non Janvier , Février.... mais bon quand il n'y a plus que çà à renommer.
Je n'ai aussi qu'un onglet à mon classeur mais je suppose que c'était pour l'essai et les macros ne sont plus là, c'est normal?
Merci

 

[Efgé]

Re : Creer classeur depuis valeur

Re
Si je comprend bien, c'est tout le classeur modèle qu'il faut sauvegarder ?
Pour le nom (passer de 1 à janvier) ça ne doit pas être trop compliqué.
Je regarde demain (dites moi si c'est bien tout le classeur).
Cordialement

 

[hypo78]

Re : Creer classeur depuis valeur

Bonsoir, oui il me faudrait tout le classeur (il n'a que 2 feuilles), mais aussi la macro.
Cordialement;
Merci

 

[hypo78]

Re : Creer classeur depuis valeur

voici un exemple parmi tant pour créer les jours d'une année dans une colonne

Sub Calendrier()
'source:Alain Vallon, mpfe
  varAn = Year(Date)
  If varAn = 0 Then Exit Sub
  X = DateSerial(varAn, 1, 1)
  Y = DateValue("31 décembre " & varAn)
  For i = 0 To Y - X
    Range("A" & i + 1) = X + i
  Next
  Columns("A:A").NumberFormat = "ddmmyyyy"
End Sub

[/QUOTE]

Depuis que j'ai testé cette macro, quand je lance la mienne (celle du début du post) mes dates sont au format Anglais!!!!
par exemple du coup j'ai un classeur nommé 02Mars2001 avec une date en AK1 du 03/02/2011.
Comment faire, je n'ai enregistré cette macro nulle part.
Merci d'avance

 

[Staple1600]

Re : Creer classeur depuis valeur

Bonsoir


Merci à Efgé d'avoir rejoint la partie

hypo78:
Mets un ' devant cette ligne
Columns("A:A").NumberFormat = "ddmmyyyy"

 

[hypo78]

Re : Creer classeur depuis valeur

bonjour,
merci pour l'astuce, mais mon problème est suite à cette macro :

Sub Creation_classeur_nommé()

DateDeSaisie = InputBox("Saisir la date de la garde que vous voulez préparer sous la forme jj/mm/aaaa")
    On Error Resume Next
Workbooks.Open Filename:="C:\Users\Thierry\Desktop\Versaillesbis\modèle_VRS.xls"
ActiveWorkbook.Sheets("01").Select
Range("AK1") = DateDeSaisie
If Dir(ActiveWorkbook.Path & "\" & Format(DateDeSaisie, "mmmmyyyy"), vbDirectory) = "" Then MkDir ActiveWorkbook.Path & "\" & Format(DateDeSaisie, "mmmmyyyy")
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & Format(DateDeSaisie, "mmmmyyyy") & "\" & Format(DateDeSaisie, "ddmmmmyyyy") & ".xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub

la macro me crée bien le classeur nommé avec la date française, par contre dans ce classeur en cellule "AK1" je me retrouve avec la date en anglais!

Ce problème est apparu hier, avant la même macro fonctionnait...

 

[Efgé]

Re : Creer classeur depuis valeur

Bonjour à tous, au fil, au forum,
Une nouvelle proposition.
Comme il y a un risque majeur d'écraser les fichiers si ils sont déja créés, j'ai ajouter un message d'avertissement.
Je crée un classeur avec l'année à l'intérieur duquel je crée un classeur par mois et deans les fichiers nommés à la date du jour. (au passage, j'inscrit la date en AK1 de la feuille 01 au format français)

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Const modele As String = _
"F:\Data\Feuilles de garde\Versaillesbis\modèle_VRS.xls"
Dim sDossier$, sDossier2$, i&, varAn, X, Y, Deb, Cpt&, Liste()
Liste = Array("", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")
Deb = Timer: varAn = Year(Date)
If varAn = 0 Then Exit Sub
X = DateSerial(varAn, 1, 1): Y = DateValue("31 décembre " & varAn)
Workbooks.Open modele
With ActiveWorkbook
    sDossier = .Path & "\" & varAn
    If Dir(sDossier, vbDirectory) = "" Then
        MkDir sDossier
    Else
        rep = MsgBox("Le classeur " & varAn & " existe déja" _
            & vbLf & "Voulez vous le remplacer ?", _
            vbYesNo + vbExclamation + vbDefaultButton1, "Avertissement")
        If rep <> vbYes Then .Close False: Exit Sub
    End If
    For i = 0 To Y - X
        sDossier2 = sDossier & "\" & Liste(Month(X + i)) & "_" & varAn
        .Sheets("01").Range("AK1") = Format(X + i, "mm/dd/yyyy")
        If Dir(sDossier2, vbDirectory) = "" Then MkDir sDossier2
        .SaveAs sDossier2 & "\" & Format(X + i, "dd_mmmm_yyyy") & ".xls"
        Cpt = Cpt + 1
    Next i
    .Close True
End With
Application.ScreenUpdating = True: Application.DisplayAlerts = True
MsgBox "Traitement Terminé" & vbLf & _
         Cpt & " Classeurs créés" & vbLf & _
         "en " & Format(Timer - Deb, "0.00") & " Secondes"
End Sub

Cordialement

 

[hypo78]

Re : Creer classeur depuis valeur

Bonjour Efgé,
çà fonctionne bien, merci.
Pourrais-tu juste m'expliquer ce qui diffère entre ton code et le mien pour que la date soit en français.
Et si je dois créer l'année 2012? ou dois-je entrer cette donnée?

 

[Efgé]

Re : Creer classeur depuis valeur

Re
Pour le format de date en français il faut utiliser : Format(Date, "mm/dd/yyyy")
Pour changer l'année il faut changer la varible varAn, varAn = Year(Date), par varAn = "2012". (ou attendre le 02 Janvier 2012 en ne touchant à rien )
Mais vous auriez pu trouver tout ça en fouillant dans le code ...
Cordialement

 

[hypo78]

Re : Creer classeur depuis valeur

Re,
mes premiers contacts avec VBA sont assez récent, et pour tout dire je suis sur ce fichier depuis quelques jours et à chaque fois que je change un truc c'est un autre qui ne fonctionne plus, du coup je n'ose plus rien toucher.
C'est pour çà que je vais abuser une dernière fois de votre gentillesse.
Dans mon code de début de post, quand je crée un classeur (une seule date), il me le mets dans un dossier nommé mmmyyy.
J'aimerai comme dans votre macro avoir une arborescence année/mois/jour.xls
Quelles sont les lignes à supprimer dans votre macro pour faire un seul classeur depuis une date saisie.
Mille merci en tout cas pour le travail.

 

[Efgé]

Re : Creer classeur depuis valeur

Re
Je dois avouer que je n'ai rien compris à l'arborescence dont vous parlez.
Pouvez vous être un peu plus précis ?
Cordialement

 

[hypo78]

Re : Creer classeur depuis valeur

re,
avec votre macro à partie du classeur "modèle, çà crée un classeur du type 01_février_2011 qui se place dans un dossier février_2011 lui même dans un dossier 2011; alors que la macro de début de post me crée le classeur et le dossier du mois mais pas de l'année.
En espérant avoir été clair cette fois ci et en vous remerciant encore une fois de votre patience.

 

[Efgé]

Re : Creer classeur depuis valeur

Re
Avec ce que j'ai compris, une proposition:

Sub Creation_classeur_nommé_3()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
DateDeSaisie = Range("b8")
Const modele As String = _
"F:\Data\Feuilles de garde\Versaillesbis\modèle_VRS.xls"
Liste = Array("", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")
Workbooks.Open modele
With ActiveWorkbook
    .Sheets("01").Range("AK1") = DateDeSaisie
    sDossier1 = .Path & "\" & Year(DateDeSaisie)
    If Dir(sDossier1, vbDirectory) = "" Then MkDir sDossier1
    sDossier2 = sDossier1 & "\" & Liste(Month(DateDeSaisie))
    If Dir(sDossier2, vbDirectory) = "" Then MkDir sDossier2
    If Dir(sDossier2 & "\" & Format(DateDeSaisie, "dd_mmmm_yyyy") & ".xls") = "" Then
        .SaveAs sDossier2 & "\" & Format(DateDeSaisie, "dd_mmmm_yyyy") & ".xls"
    Else
        rep = MsgBox("Le classeur " & Format(DateDeSaisie, "dd_mmmm_yyyy") & ".xls" & " existe déja" _
            & vbLf & "Voulez vous le remplacer ?", _
            vbYesNo + vbExclamation + vbDefaultButton1, "Avertissement")
        If rep = vbNo Then
            .Close False
            Exit Sub
        Else
            .SaveAs sDossier2 & "\" & Format(DateDeSaisie, "dd_mmmm_yyyy") & ".xls"
        End If
    End If
    .Close True
End With
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub

Cordialement

 

[hypo78]

Re : Creer classeur depuis valeur

re,
merci je teste çà dans la journée.