[VBA]choisir l'emplacement d'enregistrement

Ce code me permet d'enregistrer mon fichier dans mon répertoire download

Je souhaiterais pouvoir laisser le choix à l'utilisateur de son répertoire d'enregistrement. J'ai réussi cette partie mais le nom du fichier n'apparait pas dans la fenêtre d'enregistrement et cela enregistre le document sous "faux"

Le code initial

Sub Enreg_VRF()
Dim New_Wbk As Workbook, This_Wbk As Workbook
Dim Sh As Worksheet
Dim LePath As String, LeNom As String
Application.ScreenUpdating = False
Set New_Wbk = Workbooks.Add
Set This_Wbk = ThisWorkbook
For Each Sh In This_Wbk.Worksheets
    If Left(Sh.Name, 2) = "F_" Then
        Sh.Copy After:=New_Wbk.Sheets(Sheets.Count)
    End If
Next Sh
Application.DisplayAlerts = False
LePath = "C:\Users\" & Environ("UserName") & "\Downloads\"
LeNom = Format(Now(), "DD-MMM-YYYY hh mm AMPM") & "_Fichier de construction de nouvelles bulles techniques.xlsx"
With New_Wbk
    .Sheets(1).delete
    .SaveAs LePath & LeNom
    .Close
End With
MsgBox "Le fichier de construction a été généré sous " & "C:\Users\" & Environ("UserName") & "\Downloads\"
End Sub

L'un de vous peut-il m'éclairer ? Je suppose que je dois utiliser Application.GetSaveAsFilename mais cela m'a donné le résultat:

• choix de l'emplacement --> OK
• Conservation du nom du fichier--> nok

Bonjour

une essai.. en utilisant une fonction que j'ai en stock qui demande a l'utilisateur de renseigner un dossier cible

Sub Enreg_VRF()
Dim New_Wbk As Workbook, This_Wbk As Workbook
Dim Sh As Worksheet
Dim LePath As String, LeNom As String
Application.ScreenUpdating = False
Set New_Wbk = Workbooks.Add
Set This_Wbk = ThisWorkbook
For Each Sh In This_Wbk.Worksheets
    If Left(Sh.Name, 2) = "F_" Then
        Sh.Copy After:=New_Wbk.Sheets(Sheets.Count)
    End If
Next Sh
Application.DisplayAlerts = False
'LePath = "C:\Users\" & Environ("UserName") & "\Downloads\"
LePath = ChoixDossier & "\" 
LeNom = Format(Now(), "DD-MMM-YYYY hh mm AMPM") & "_Fichier de construction de nouvelles bulles techniques.xlsx"
With New_Wbk
    .Sheets(1).delete
    .SaveAs LePath & LeNom
    .Close
End With
MsgBox "Le fichier de construction a été généré sous " & "C:\Users\" & Environ("UserName") & "\Downloads\"
End Sub

Function ChoixDossier()
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choisir le dossier de destination"
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
     Else
       ChoixDossier = InputBox("Répertoire?")
     End If
End Function

Fred

Fred merci pour ton retour cependant c'est plus ce type d'affichage que je cherche

la ou ta fonction me donne

Re bonjour

Le problème c'est qu'avec ta méthode, tu cherche a enregistrer un fichier (il faut donc lui donner un nom dans la fenêtre qui s'ouvre), l'utilisateur met quoi ??? n'importe quoi ?? sélectionne un fichier existant ??? .. alors que tu fais la création du nom d'enregistrement dans la macro.. pour moi c'est pas cohérent...

d'après moi il faut demander a l'utilisateur de choisir que le dossier d'enregistrement d'où le code que je propose..

Fred

Bon une autre proposition

Sub Enreg_VRF()
Dim New_Wbk As Workbook, This_Wbk As Workbook
Dim Sh As Worksheet
Dim LePath As String, LeNom As String
Dim REP As FileDialog
Set REP = Application.FileDialog(msoFileDialogSaveAs)
Application.ScreenUpdating = False
Set New_Wbk = Workbooks.Add
Set This_Wbk = ThisWorkbook
For Each Sh In This_Wbk.Worksheets
    If Left(Sh.Name, 2) = "F_" Then
        Sh.Copy After:=New_Wbk.Sheets(Sheets.Count)
    End If
Next Sh
Application.DisplayAlerts = False
'LePath = "C:\Users\" & Environ("UserName") & "\Downloads\"
'LeNom = Format(Now(), "DD-MMM-YYYY hh mm AMPM") & "_Fichier de construction de nouvelles bulles techniques.xlsx"
    New_Wbk.Sheets(1).delete
    With REP
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\" & Format(Now(), "DD-MMM-YYYY hh mm AMPM") & "_Fichier de construction de nouvelles bulles techniques.xlsx" 
       .Title = "Choix du dossier"
        If .Show = -1 Then
           New_Wbk.SaveAs Filename:=.SelectedItems(1)
            New_Wbk.Close
        End If
    End With
   '.SaveAs LePath & LeNom

MsgBox "Le fichier de construction a été généré sous " & "C:\Users\" & Environ("UserName") & "\Downloads\"
End Sub

Mais dans cette solution le nom imposé par la macro, si il est changé par l'utilisateur... tu ne pourras pas le détecter..

Fred

Je comprends.

L'idée générale est d'avoir un nom prédéfini au fichier avant sauvegarde (que l'utilisateur veuille ou pas le renommer n'est pas bloquant).

Ton dernier code répond à mon besoin. merci

Re bonjour

Dans ce cas...

A+

Fred