Sauvegarde suivant données dans cellule

[Chris_67]

Bonjour à tous,

Alors voilà, je voudrais faire une sauvegarde automatique suivant des données se trouvant dans différentes cellules.

A savoir :
- Une cellule chemin, créée par une formule
- Une cellule nom, créée par une autre formule
- Une cellule enfin, qui doit servir à créer un répertoire de sauvegarde (ce qui me pose problème)

J'ai pu récupérer une partie du code sur d'autres posts ouverts, mais je rencontre un problème : lorsque le répertoire n'existe pas, nickel, mais dès qu'il existe, il faudrait que je passe à la sauvegarde directement dans ce répertoire.
Etant débutant, est-ce que quelqu'un pourrait m'éguiller ?

Merci d'avance.
Je joins mon fichier de travail.
Salut à tous.

 

[Excel-lent]

Re : Sauvegarde suivant données dans cellule

Salut Chris_67,

Voici ci-dessous le code qui t'intéresse. A adapter à ton fichier.

' Test si le répertoire existe
If Dir("\\le chemin de ton fichier - nom de répertoire inclus", vbDirectory) <> "" Then
---' le répertoire existe déjà -> donc ok! Ne rien à faire
---Else
---' le répertoire n'existe pas encore -> création du répertoire
---MkDir "\\le chemin de ton fichier - nom de répertoire inclus"
End If

' Test si le fichier existe déjà
If Dir("\\le chemin nom de répertoire inclus" & "Nom de ton fichier" & ".xls", vbHidden) <> "" Then
---' Le fichier existe déjà -> Ne rien faire
---MsgBox "Le fichier existe déjà!" & vbCrLf & vbCrLf & "La sauvegarde n'a pu être réalisé"
Else
---' Le fichier n'existe pas
---ChDir "\\le chemin de ton fichier - nom de répertoire inclus" & "Nom de ton fichier" & ".xls"
---ActiveWorkbook.SaveAs "\\le chemin de ton fichier - nom de répertoire inclus" & "Nom de ton fichier" & ".xls"
---MsgBox "Le fichier n'existait pas, la sauvegarde a bien été effectué!"
End If

Bonne après midi
A+

 

[Chris_67]

Re : Sauvegarde suivant données dans cellule

Merci, c'est Excel-lent !
Me suis inspiré de ton code et ca a donné ca :

Sub Enregistrer()

'création du répertoire de sauvegarde
Dim TheFullPath As String
Dim TheSplitedPath As Variant
Dim i As Byte, NbRep As Byte
Dim ThePath As String

TheFullPath = Range("r10")
TheSplitedPath = Split(TheFullPath, "r10")

NbRep = UBound(TheSplitedPath)
For i = 0 To NbRep
ThePath = ThePath & TheSplitedPath(i)
MakingDir ThePath 'répertoire de sauvegarde créé !


'sauvegarde du fichier
Dim Nom As String 'nom du fichier à sauvegarder
Nom = Range("T10") 'cellule contenant le nom du fichier
ThisWorkbook.SaveAs TheFullPath & Nom

Next
End Sub

Sub MakingDir(ThePath As String)
On Error GoTo TheEnd
MkDir ThePath
TheEnd:
End Sub

Suis débutant, j'sais pas si c'est très propre mais ca marche apparemment !
Merci encore