Modifier le chemin de la sauvegarde

[sev]

Meilleurs voeux à tous le forum.

J'ai trouvé un code pour sauvegarder un classeur.
Je voudrais que les sauvegardes se fassent sur une clé USB et que le fichier d'origine reste sur le disque dur .
Serait-il possible qu'un messagebox me propose cette sauvegarde lors de la fermeture du classeur ?

Voici le code en question :


Option Explicit
Option Private Module

Const NbVersions As Integer = 5

Sub SauvegardeIncrementee()
Dim Wbk As Workbook, NomF As String, NNom As String, NNomMin As String
Dim StrDate As String, Message As String, Reponse, MaxV As Integer
Dim Chemin As String, Ext As String
Dim Fs As Object, Bcle As Integer

On Error GoTo erreur
Set Fs = CreateObject("Scripting.FileSystemObject")

Set Wbk = ActiveWorkbook
If Wbk Is Nothing Then Exit Sub
With Wbk
.Save
NomF = .Name
Chemin = .Path & "\"
Ext = Mid(NomF, InStrRev(NomF, "."))

If Ext = "." Then
MsgBox "Erreur, ce fichier n'est pas sauvegardé", vbInformation, "Sauvegarde"
Exit Sub
End If
End With

NomF = Left$(NomF, InStrRev(NomF, ".") - 1)

If Mid$(NomF, Len(NomF) - 2, 1) = "-" Then
If IsNumeric(Right$(NomF, 2)) Then NomF = Trim(Left$(NomF, Len(NomF) - 3))
End If
If Len(NomF) > 8 Then
If IsDate(Replace(Right$(NomF, 8), "_", "/")) Then
NomF = Trim(Left$(NomF, Len(NomF) - 8))
Message = "Ce fichier est déjà un fichier de sauvegarde incrémentée..." & _
vbCr & "Le sauvegarder sous " & NomF & Ext & " ?"
Reponse = MsgBox(Message, vbInformation + vbYesNo, "Sauvegarde")
If Reponse = vbNo Then Exit Sub
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Chemin & Trim(NomF) & Ext
Application.DisplayAlerts = True
End If
End If

For Bcle = 1 To NbVersions
NNom = NomF & " " & Format(Date, "dd_mm_yy") & Format(Bcle, "-00")
NNomMin = NomF & " " & Format(Date, "dd_mm_yy") & Format(Bcle - 1, "-00")
On Error Resume Next
Set Wbk = Nothing
Set Wbk = Workbooks(NNom & Ext)
If Not Wbk Is Nothing Then
MsgBox "Erreur, le fichier " & NNom & Ext & " doit être fermé", vbInformation, "Sauvegarde"
Exit Sub
End If
On Error GoTo erreur
NNom = Chemin & NNom & Ext
If Dir(NNom) <> "" Then MaxV = MaxV + 1
If MaxV > 1 Then
If MaxV = Bcle Then
Fs.CopyFile NNom, Chemin & NNomMin & Ext, True
Else
Exit For
End If
End If
Next Bcle
Set Fs = Nothing

If MaxV < NbVersions Then MaxV = MaxV + 1
NNom = NomF & " " & Format(Date, "dd_mm_yy") & Format(MaxV, "-00")
ActiveWorkbook.SaveCopyAs Chemin & NNom & Ext
Exit Sub

erreur:
Application.DisplayAlerts = True
MsgBox "Erreur à la sauvegarde...", vbInformation, "Sauvegarde"
End Sub




Merci pour votre aide

 

[skoobi]

Re : Modifier le chemin de la sauvegarde

Bonjour,

Serait-il possible qu'un messagebox me propose cette sauvegarde lors de la fermeture du classeur ?

Dans ce cas il faut mettre le code dans le code évenementielle de fermeture du classeur.
Pour y accéder: double clic sur "thisworkbook" dans VBE puis mettre le code ici:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
le code
End Sub

 

[sev]

Re : Modifier le chemin de la sauvegarde

Merci , mais pour la sauvegarde sur clé USB ?

 

[skoobi]

Re : Modifier le chemin de la sauvegarde

Re,
Et bien la variable chemin sera par exemple:
chemin = "E:\" si la lettre est "E" pou ta clé USB, je vois pas trop le soucis 😕