Sujet Précédent Sujet Suivant

Enregistrement automatique

Résolu/Fermé
pzyko Messages postés 34 Date d'inscription vendredi 27 juin 2014 Statut Membre Dernière intervention 8 août 2014 - 17 juil. 2014 à 15:13
pzyko Messages postés 34 Date d'inscription vendredi 27 juin 2014 Statut Membre Dernière intervention 8 août 2014 - 22 juil. 2014 à 14:46
Bonjour,

Je cherche à faire une macro qui me permettra d'enregistrer automatiquement mon classeur excel au bon endroit.
Voici le début du chemin de sauvegarde qui ne change pas :
C:\Users\kbel\Desktop\Nom\
Dans le répertoire "Nom", il doit y avoir des sous-répertoires portant le nom de l'année concernée.
Dans ce sous répertoire du nom de l'année, il doit y avoir des sous répertoires dont le nom est S suivi du numéro de semaine (de 1 à 52). Exemple : S37 pour la semaine 37.
Enfin dans chacun de ces répertoires, il y a le fichier correspondant à la semaine. En réalité, il y a dans chaque répertoire semaine plusieurs fichiers (1 par type de client sachant qu'il y a 5 types de clients).

J'ai actuellement un dossier 2014 de créé, dans lequel il y a déjà des dossiers semaine.

Ce que j'aimerais c'est qu'en exécutant la macro, excel vérifie dans le dernier répertoire semaine de l'année en cours, s'il contient bien le fichier correspondant à cette semaine et au type de clients concerné. Si oui, je veux qu'il créé un nouveau répertoire du nom S suivi du numéro de semaine suivant et qu'il y sauvegarde mon fichier, sinon, je veux qu'il enregistre mon fichier dans le dernier répertoire existant.
Je veux qu'il fasse cela jusqu'à la semaine 52. Une fois qu'il y a le répertoire semaine S52 de créé et qu'il contient le fichier correspondant, je voudrais qu'il me créé un nouveau répertoire du nom de l'année suivante dans lequel il crééra un répertoire de semaine S1 dans lequel s'enregistrera le fichier correspondant.

Le fichier doit être enregistré avec le nom suivant :
FICHIER_type de client_S"suivi du numéro de semaine
exemple en admettant que TC est l'un des types de client et que le fichier correspond à la semaine 5 :
FICHIER_TC_S5.xlsm

Pour vérifier quel est le type de clients concerné, il faut vérifier qu'une des feuilles du classeur contient le nom de ce type de clients.
Dans l'exemple ci-dessus, il faudrait vérifier qu'une des feuilles du classeur contient TC.

J'aimerais que le numéro d'année et de semaine ne soit pas calculé à partir de l'année ou la semaine réellement en cours car le fichier peut être enregistré avec de l'avance ou du retard.

Novice en VBA, j'ai tenté de créer cette macro mais je n'y parviens pas. J'en suis arrivé à ce code (qui ne fonctionne pas mais qui peut peut-être aider à comprendre) où s = numéro de semaine et u numéro de l'année (ce code a été créé en imaginant qu'il n'y a pas différents types de clients et donc pas différents fichiers dans les dossiers semaine) : 

Sub saveas()

Application.DisplayAlerts = False

Dim s As Integer
Dim u As Integer


s = 1
u = 2014
    
    Do Until DossierExiste("C:\Users\kbel\Desktop\Nom\" & u & "\S52\FICHIER_S52.xlsm") = True And DossierExiste("C:\Users\kbel\Desktop\Nom\" & u + 1) = False
        u = u + 1
    Loop
    
    If DossierExiste("C:\Users\kbel\Desktop\Nom\" & u & "\S52\FICHIER_S52.xlsm") = True Then
        MkDir ("C:\Users\kbel\Desktop\Nom\" & u + 1)
        MkDir ("C:\Users\kbel\Desktop\Nom\" & u + 1 & "\S1")
        u = u + 1
    End If
    
    While DossierExiste("C:\Users\kbel\Desktop\Nom\" & u & "\S" & s + 1) = True
        s = s + 1
        If s = 52 Then
            s = 1
        End If
    Wend
    
    If DossierExiste("C:\Users\kbel\Desktop\Nom\" & u & "\S" & s & "\FICHIER_S" & s & ".xlsm") = True Then
                MkDir ("C:\Users\kbel\Desktop\Nom\" & u & "\S" & s + 1)
        ActiveWorkbook.saveas Filename:= _
            "C:\Users\kbel\Desktop\Nom\" & u & "\S" & s + 1 & "\FICHIER_S" & s + 1, FileFormat:= _
            xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Else
        ActiveWorkbook.saveas Filename:= _
            "C:\Users\kbel\Desktop\Nom\" & u & "\S" & s & "\FICHIER_S" & s, FileFormat:= _
            xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End If


Application.DisplayAlerts = True


End Sub

Function DossierExiste(NomDossier As String) As Boolean
    DossierExiste = Dir(NomDossier, vbDirectory) <> ""
End Function



J'espère avoir été clair et vous remercie par avance pour votre aide !

1 réponse

Réponse 1 / 1
pzyko Messages postés 34 Date d'inscription vendredi 27 juin 2014 Statut Membre Dernière intervention 8 août 2014 1
22 juil. 2014 à 14:46
J'ai fini par trouver seul. Je mets le code si cela peut aider quelqu'un. 


Sub Sauvegarde_auto()

Dim Chemin, Mot As String
Dim s, u, j, m, n, o As Integer
Dim TC(), TC2()

TC = Array("TYPE1", "TYPE2", "TYPE3")
TC2 = Array("TYPE1_CLT", "TYPE2_CLT")

j = Worksheets.Count

For m = 1 To j
    If Worksheets(m).Name Like "*CLT*" Then
        For n = LBound(TC2) To UBound(TC2)
            If InStr(1, Worksheets(m).Name, TC2(n)) > 0 Then
                Mot = TC2(n)
                Exit For
            End If
        Next n
    Else
        For o = LBound(TC) To UBound(TC)
            If InStr(1, Worksheets(m).Name, TC(o)) > 0 Then
                Mot = TC(o)
                Exit For
            End If
        Next o
    End If
Next m


u = 2014

Do
    If Not Dir("C:\Users\kbel\Desktop\Nom\" & u & "\S52\FICHIER_" & Mot & "_S52.xlsm", vbDirectory) = "" Then
        u = u + 1
    Else
        Exit Do
    End If
Loop

For s = 1 To 52
    If Dir("C:\Users\kbel\Desktop\Nom\" & u & "\S" & s & "\FICHIER_" & Mot & "_S" & s & ".xlsm", vbDirectory) = "" Then
        Chemin = "C:\Users\kbel\Desktop\Nom"
            If Not Dir(Chemin, vbDirectory) = "" Then
                Chemin = Chemin & "\" & u
                    If Dir(Chemin, vbDirectory) <> "" Then
                        Chemin = Chemin & "\S" & s
                            If Dir(Chemin, vbDirectory) <> "" Then
                                ThisWorkbook.saveas Chemin & "\FICHIER_" & Mot & "_S" & s & ".xlsm"
                                Exit For
                            Else
                                MkDir (Chemin)
                                ThisWorkbook.saveas Chemin & "\FICHIER_" & Mot & "_S" & s & ".xlsm"
                                Exit For
                            End If
                    Else
                        MkDir (Chemin)
                        Chemin = Chemin & "\S" & s
                            If Dir(Chemin, vbDirectory) <> "" Then
                                ThisWorkbook.saveas Chemin & "\FICHIER_" & Mot & "_S" & s & ".xlsm"
                                Exit For
                            Else
                                MkDir (Chemin)
                                ThisWorkbook.saveas Chemin & "\FICHIER_" & Mot & "_S" & s & ".xlsm"
                                Exit For
                            End If
                    End If
            End If
    End If
Next s


End Sub
0

Discussions similaires

Supprimer ouverture automatique après enregistrement sous PDF
FredM33 -
FredM33 -

6 réponses