XL 2010 Changer le nom dans une boîte de dialogue

[Cydor007]

Bonjour,

J'aimerais savoir comment on fait pour modifier le nom du fichier à travers une boîte de dialogue.
Je m'explique:

J'ai ajouté un bouton sur un formulaire qui permet à l'utilisateur de sauvegarder un classeur excel en sélectionnant l'emplacement, le nom du fichier et le type d'extension. Le nom du fichier est créé à travers le formulaire. C'est à dire que selon ce qui est écrit dans le formulaire le nom du fichier s'adapte.

Le problème est le suivant: Il se peut que l'utilisateur veule modifier le nom du fichier. Mais je n'arrive pas à le faire, car quand le fichier s'enregistre et pointe toujours vers la source Nom. J'aimerais pouvoir mettre une condition si le Nom est modifié par l'utilisateur.

Voici le code:

Sub Enregistrer_sous()
Dim sNom As Variant
Dim Nom As String
Dim Chemin As String
Dim MonDossier As String
Dim extension As String
extention = ".xlsm"
Chemin = "Q:\"
MonDossier = "Ingenierie\Departement Ingenierie\3_AI non signés"
Nom = "AI " & Sheets("Formulaire AI").Range("M1") & " (" & Sheets("Formulaire AI").Range("D13") & " " & "rév_" & " " & Sheets("Formulaire AI").Range("C13") & ")" & extension
ChDrive "Q:"
ChDir Chemin & MonDossier
sNom = Application.GetSaveAsFilename(InitialFileName:=Nom, _
fileFilter:="xlsm (*.xlsm), *.xlsm")
If sNom = False Then Exit Sub
Application.DisplayAlerts = True
ActiveWorkbook.SaveAs Nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Est-ce que c'est possible d'éditer le nom du fichier au travers la boîte de dialogue et ensuite enregistrer le fichier avec le nouveau nom?

Merci

Cydor007

 

[thebenoit59]

Bonjour Cydor.

Peux-tu transmettre ton fichier, nettoyé des données sensibles ? Tu auras plus facilement une réponse à ta demande.

 

[Bougla972]

Bonjour Cydor, thebenoit59,

Essaie ceci:

Sub Enregistrer_sous()
Dim sNom As Variant
Dim Nom As String
Dim Chemin As String
Dim MonDossier As String
Dim extension As String
extention = ".xlsm"
Chemin = "P:\"
MonDossier = "Ingenierie\Departement Ingenierie\3_AI non signés"
Nom = "AI " & Sheets("Forme et Classe").Range("B1") & extension
sNom = ThisWorkbook.Name
sNom = Application.GetSaveAsFilename(sNom, "Fichiers Excel (*.xlsm), *.xlsm")
If sNom = False Then Exit Sub
Application.DisplayAlerts = True
'ActiveWorkbook.SaveAs Nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.SaveAs sNom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

 

[Cydor007]

Bonjour Bougla972,

J'ai adapté ton code à mes besoins et cela fonctionne très bien.

Voici le résultat:

Sub Enregistrer_sous()
Dim sNom As Variant
Dim Nom As String
Dim Chemin As String
Dim MonDossier As String
Dim extension As String
extention = ".xlsm"
Chemin = "Q:\"
MonDossier = "Ingenierie\Departement Ingenierie\3_AI non signés"
Nom = "AI " & Sheets("Formulaire AI").Range("M1") & " (" & Sheets("Formulaire AI").Range("D13") & " " & "rév_" & " " & Sheets("Formulaire AI").Range("C13") & ")" & extension
sNom = ThisWorkbook.Name
sNom = Application.GetSaveAsFilename(Nom, "Fichiers Excel (*.xlsm), *.xlsm")
If sNom = False Then Exit Sub
Application.DisplayAlerts = True
'ActiveWorkbook.SaveAs Nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.SaveAs sNom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Cela fait exactement ce à quoi je m'attandais.

Merci pour tes lumières.

Cydor007