Problème de Sauvegarde

cdlmars5

XLDnaute Nouveau
Bonjour à toutes/tous,

voilà, j'aimerais que le nom du fichier (utilisé par plusieurs collègues) soit composé de plusieurs variables (le N° du dossier, le client ainsi que l'évènement).

De ce fait, j'ai inclus le code dans "BeforeSave" car j'aimerais que l'utilisateur puisse utiliser l'outil "Enregistrer (soit la disquette)" pour pouvoir ensuite déterminer automatiquement le nom du fichier (cf fonction "Nom_Metré" dans le module "Gestion_Sauvegarde"). Le hic, c'est que le code ferme le fichier une fois la sauvegarde faite, sans compter que parfois, le code s'effectue 2 fois (comme si le fait de sauvegarder, réactivais "BeforeSave").

Voici le code :

Code:
Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim Message As String, Nom_Classeur As String, Classeur_Actif As String
Dim Evenement As String, Fichier As String, Chemin As String, dossier As String, Client As String, char As String, temp As String, Nom_Fichier As String

Client = Sheets("Feuil1").Range("J2")
dossier = Sheets("Feuil1").Range("D2")
Evenement = Sheets("Feuil1").Range("D5")
Chemin = "C:\Documents and Settings\user\Bureau\Metré\TEST\"

Nom_Classeur = Nom_Metré(1)
Classeur_Actif = ActiveWorkbook.Name


If dossier = "" Or Client = "" Or Evenement = "" Then
    Message = "Complètez les données du metré avant de sauvegarder" & vbNewLine & " Les donnnées suivantes sont manquantes : "
    If dossier = "" Then
        Message = Message & vbNewLine & "   -   N° de dossier (Cellule D2)"
    End If
    If Client = "" Then
        Message = Message & vbNewLine & "   -   Nom du client (Cellule J2)"
    End If
    If Evenement = "" Then
        Message = Message & vbNewLine & "   -   Evenement (Cellule D5)"
    End If
    Message = MsgBox(Message, vbExclamation)
    Cancel = True
    Exit Sub
End If

Application.EnableEvents = False

If Nom_Classeur <> Nom_Fichier Then
    
ActiveWorkbook.SaveAs Filename:=Chemin & Nom_Classeur

Application.EnableEvents = True
End If


End Sub

Je m'arrache les cheveux depuis ce matin, et je ne trouve pas de solution.

Un gros bisou à celui qui trouvera mon erreur !
 

Pièces jointes

  • TEST.xls
    95 KB · Affichages: 46
  • TEST.xls
    95 KB · Affichages: 44
  • TEST.xls
    95 KB · Affichages: 48

Discussions similaires

Réponses
6
Affichages
204

Statistiques des forums

Discussions
312 239
Messages
2 086 500
Membres
103 236
dernier inscrit
Menni