XL 2016 modifier nom répertoire

BALANCIE

XLDnaute Junior
Bonjour à tous,

Voici mon petit problème.
J'ai un fichier que je peux à loisir modifier selon mes besoins. Mais lorsque je le confie à une autre personne , je ne veux pas qu'elle "farfouille" dans le code VBA.
Mais selon ses besoins, elle a la nécessite la première fois d'indiquer le chemin du répertoire de sa double sauvegarde sur son PC qui n'est pas le même que le mien.
J'aurais besoin d'une modification de ma macro pour lui permettre la première fois de créer le répertoire en question, mais seulement la première fois afin d'éviter à chaque fois l'opération.
Où seulement changer la date par une date de son choix (cela peut-être aussi une solution).
Est-ce possible ? où alors je me complique la vie !.

Code:
Sub SauvegardeDouble()

Dim MonChemin As String
Dim MonCheminDistant As String
Dim LeNom As String
Dim LaDate As String

MonChemin = ThisWorkbook.Path & "\" ' pour les chemins, ne pas oublier le "\"
MonCheminDistant = "D:\MON DOSSIER\PROJET\GESTION\GESTION ABS 2019\Save\"
LeNom = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) ' <<< il faut supprimer l'extension du nom afin qu'il ne se répète pas
LaDate = Format(Now, "DD-MM-YY") & ".xlsm" ' format de la date désiré

ActiveWorkbook.Save

On Error Resume Next

Application.DisplayAlerts = False ' désactive les messages d'alerte
ActiveWorkbook.SaveAs MonCheminDistant & LeNom & " Save le " & LaDate, FileFormat:=52
ActiveWorkbook.SaveAs MonChemin & LeNom, FileFormat:=52
Application.DisplayAlerts = True ' extrêmement important de les réactiver

Select Case MsgBox("Sauvegarde en double réussie.", , "Double sauvegarde.")

End Select

End Sub

Merci à vous.
 

cp4

XLDnaute Accro
Bonsoir,

Une proposition code à mettre dans le module de Thisworkbook à tester
VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'appeler en 1er macro qui enregistre le fichier
'ici....

'puis invite pour choisir le chemin de la 2ème sauvegarde
Application.Dialogs(xlDialogSaveAs).Show
End Sub
Bonne soirée.
 

cathodique

XLDnaute Accro
Bonjour Balancie:), Cp4:),

un essai sur la base de la proposition de cp4
VB:
Sub SauvegardeDouble()
Dim LeNom As String, LaDate As String

LeNom = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) ' <<< il faut supprimer l'extension du nom afin qu'il ne se répète pas
LaDate = Format(Now, "DD-MM-YY") & ".xlsm" ' format de la date désiré

ActiveWorkbook.Save 'sauvegarde fichier

'puis invite pour choisir le chemin de la 2ème sauvegarde
Application.Dialogs(xlDialogSaveAs).Show LeNom & LaDate

MsgBox "Sauvegarde en double réussie.", , "Double sauvegarde."

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
292 799
Messages
1 926 350
Membres
183 036
dernier inscrit
Valère Rousseau