XL 2016 [RESOLU] Enregistrer un fichier dans un dossier réseau changeant

[Hynnuh]

Bonjour à tous.

J'ai un fichier excel vierge que je souhaite enregistrer directement dans le bon dossier à l'aide d'une macro
je vous partage ci-dessous ce que je souhaite faire et là ou je bloque

Je souhaite que lors de l'enregistrement la macro récupère directement l'année et le n° du dossier pour créer le chemin adéquat pour enregistrer le fichier
par exemple:
si la date est le 25/04/2018 et que le dossier à le numéro 255 alors il faudrait qu'il puisse enregistrer le fichier à l'adresse suivante: (adresse sur un réseau )
R:\Clients\2018\Dossier 1\Dossier n° 255\Dossier n°255.xlsm

J'ai essayé comme j'ai pu avec le code suivant, mais comme je le poste ici vous vous en doutez cela n'a pas fonctionné.

Sub test()
' enregistrer le fichier dans le bon dossier

Dim année As Integer 
Dim dossier As Integer
Dim NomRep As String


année = Range("N1").Value 'affecter l'année qui est dans la case N1

dossier = Range("G10").Value 'affecter le n° dossier qui est dans la cade G10

NomRep = "R:\Clients\année\Dossier 1\Dossier n°dossier\Dossier n°dossier.xlsm" 'Nom du chemin générique

   
  ChDir NomRep
  ActiveWorkbook.SaveAs Filename:= _
  "R:\Clients\année\Dossier 1\Dossier n°dossier\Dossier n°dossier.xlsm", _
  FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

merci d'avance pour votre aide

Et la cerise sur le gâteau serait que le dossier se créé tout seul si il n'existe pas déjà (quitte à demander la lune )

 

[Lone-wolf]

Bonjour Hynnuh

dossier = Range("G10").Value

If faut modifier NomRep = xxxxxxxxx, par NomRep = "R:\Clients\année\Dossier 1\" & dossier

Reste à savoir qu'est-il y a d'écrit en G10?? Parce-que dossier n°dossier ça veux rien dire. Bein oui, c'est quoi le numéro de dossier??

Et pour créer un dossier, macro à adapter

Option Explicit

Sub créer_dossiers()
Dim chemin As String, nom As String, lig As Long, i As Long

    With Feuil1
        nom = .Range("a1").Value
        lig = .Cells(Rows.Count, 2).End(xlUp).Row
        chemin = ThisWorkbook.Path & "\" & nom

        MkDir chemin

        For i = 2 To lig
            MkDir chemin & "\" & .Cells(i, 2)
        Next
    End With
End Sub

Cette macro crée un premier dossier du nom de A1 et ensuite les sous-dossiers du nom de .Cells(i, 2).

 

[Hynnuh]

Bonjour Lone-Wolf
merci de la réponse rapide

petite précision sur ce qui est en G10 et N1
N1= l'année en 4 chiffre (ici 2018)
G10= n° de dossier en 3chiffre( pour le moment) 255 dans le cas de l'exemple.

Existe t'il l'équivalent de la fonction concatener en VBA pour le chemin générique (car l'année et le n° de dossier sont les deux paramètres changeant et j'ai écris le chemin comme je l'aurais fait avec la fonction concatener, en ajoutant les variable un peu à l'arrache je l'avoue.)
pour le moment quand je lance la macro je reste avec une erreur sur le ChDir "chemin introuvable"

en changeant le NomRep cela n'a rien changé.

 

[Lone-wolf]

Re

Dans ce cas

Dim an As Long, Ndossier As String, chemin As String

'Ceci est à créer avec la macro que je t'ai montré.
an = .Range("n1").Value
Ndossier = Range("G10").Value
chemin = an & "\" & Ndossier & "\"


NomRep = "R:\Clients\" & chemin & NDossier & an & ".xlsm"

 

[Lone-wolf]

Re

Voici la macro au complet

Option Explicit

Sub Enregister_Sous()
Dim chemin As String, chemin2 As String, an As String, Ndossier As String
Dim Aw As Workbook, Tw As Workbook

    On Error Resume Next
    Application.ScreenUpdating = False

    Set Tw = ThisWorkbook

    With Tw.Feuil1
        an = .Range("n1").Value
        Ndossier = .Range("g10").Value
    End With

    chemin = "D:\" & an
    MkDir chemin


    chemin2 = chemin & "\" & Ndossier & "\"
    MkDir chemin2
    Tw.SaveAs Filename:=chemin2 & Ndossier & " - " & an & ".xlsm", _
              FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    Aw = Ndossier & " - " & an & ".xlsm"
    Aw = ActiveWorkbook
    Aw.Close True
End Sub

 

[Hynnuh]

Merci,
je joint un fichier pour illustrer cela sera plus simple je penses.

la macro est enregistrée et affectée au bouton.

 

[Lone-wolf]

Re

Comme ceci

Sub enregistrer()
Dim chemin As String, chemin2 As String, an As String, Ndossier As String
   
   Application.ScreenUpdating = False
    With Feuil1
        an = .Range("n1").Value
        Ndossier = .Range("h10").Value
        .Copy
    End With

    chemin = "R:\Clients\Dossier 1\" & "Dossier " & an

    MkDir chemin
    chemin2 = chemin & "\" & Ndossier & "\"
    MkDir chemin2

    ActiveSheet.SaveAs Filename:=chemin2 & Ndossier & an & ".xlsm", _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
    ActiveWorkbook.Close True
End Sub

 

[Hynnuh]

J'ai un soucis avec la syntaxe du chemin,
car pour moi dans le code ci-dessus
le chemin du coup ne prends plus en compte l'année ou alors après, or je ne peux pas changer
avec la macro cela donnerait donc dans l'exemple: "R:\Clients\Dossier 1\Dossier 2018 \ 255

"R:\Clients\2018\Dossier 1\Dossier n° 255

malheureusement la syntaxe doit être conservée autrement cela fera planter d'autres tableaux.

du coup le MkDir chemin bloque toujours à noter que le dossier 2018 dans le cas présent éxiste déja, pas besoin de le creer, seul le dossier n° 255 sera à creer (et à terme le dossier n° XXX)

Je ne sais pas si c'est plus clair,
sinon je vais continuer de chercher
car je penses que je ne suis pas loin.

merci en tout cas du coup de main.

 

[Lone-wolf]

Re

il faut expliquer les choses comme il faut dès le départ. Donc

chemin = "R:\Clients\Dossier 1\Dossier 2018\" & "Dossier " & Ndossier '(Dossier 255)
NomFichier = Ndossier & an & ".xlsm" (2552018.xlsm)
MkDir chemin

ActiveSheet.SaveAs Filename:=chemin & NomFichier, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

 

[Hynnuh]

Désolé si ma requête n'était pas claire,

au final voici le code que j'utilise pour enregistrer mon fichier dans un dossier qui se créé en fonction des donnée de la feuille.
avec un module de vérification si le dossier existe déjà ou pas.

Sub sauvegarder()
Dim Dossier As String, Fichier As String, Chemin As String, année As String
Dim fso
Dim enregistrer
Dim folder As String


année = Cells(1, 11).Value ' cellule qui récupère l'année selon la date
Dossier = Cells(2, 11).Value ' cellule contenant n° de dossier

'Vérification si le dossier existe déjà
folder = "R:\Clients\" & année & "\Dossier1\dossier n° " & Dossier
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(folder) Then
    MsgBox "Le dossier Existe déjà"
  GoTo enregistrer
  
Else

' création du dossier en question
MkDir "R:\Clients\" & année & "\Dossier1\dossier n° " & Dossier


enregistrer:

Chemin = "R:\Clients\" & année & "\Dossier1\dossier n° " & Dossier
ActiveWorkbook.SaveAs Filename:=Chemin & "\dossier n° " & Dossier & ".xls"




End If
End Sub