XL 2019 Boite de dialogue Save as affiche mauvaise extension

Electronull · Mercredi à 19:58

Bonsoir à tous,

Quand j'ouvre une boite de dialogue Save as en mettant le nom du fichier et l'extension .xlsm, la boite affiche le nom et .xlsx
Comment je peux remédier à ça?

VB:

' --- SAVE AS .xlsm ---
    Application.DisplayAlerts = True   ' réactive les alertes pour le dialogue
    baseName = wbDest.Name
    If InStrRev(baseName, ".") > 0 Then baseName = Left(baseName, InStrRev(baseName, ".") - 1)

    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Enregistrer le fichier CIBLE sous..."
        .InitialFileName = wbDest.Path & "\" & baseName & "_MAJ_" & Format(Date, "yyyy_mm_dd") & ".xlsm"
        If .Show = -1 Then
            nomFichier = .SelectedItems(1)
            If LCase$(Right$(nomFichier, 5)) <> ".xlsm" Then nomFichier = nomFichier & ".xlsm"
            Application.DisplayAlerts = False
            wbDest.SaveAs Filename:=nomFichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.DisplayAlerts = True
            MsgBox "Fichier enregistré sous :" & vbCrLf & nomFichier, vbInformation
        Else
            MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
        End If
    End With

Merci

Nicolas JACQUIN · Mercredi à 20:13

Bonjour,
à tester,

VB:

With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Enregistrer le fichier CIBLE sous..."
    .InitialFileName = wbDest.Path & "\" & baseName & "_MAJ_" & Format(Date, "yyyy_mm_dd") & ".xlsm"

    ' Ajoute les filtres : ici uniquement .xlsm
    .Filters.Clear
    .Filters.Add "Classeur Excel avec macros (*.xlsm)", "*.xlsm"
    .FilterIndex = 1  ' applique ce filtre par défaut

    If .Show = -1 Then
        nomFichier = .SelectedItems(1)

        If LCase$(Right$(nomFichier, 5)) <> ".xlsm" Then
            nomFichier = nomFichier & ".xlsm"
        End If

        Application.DisplayAlerts = False
        wbDest.SaveAs Filename:=nomFichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.DisplayAlerts = True

        MsgBox "Fichier enregistré sous :" & vbCrLf & nomFichier, vbInformation
    Else
        MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
    End If
End With

Nicolas

patricktoulon · Mercredi à 20:32

Bonjour
je te propose le dialog autre que celui de l'application il est plus simple et moins retord que celui de l'application.fildialog

voici ton code repris

VB:

 ' --- SAVE AS .xlsm ---
     BaseName = wbdest.Name
    If InStrRev(BaseName, ".") > 0 Then BaseName = Mid(BaseName, 1, InStrRev(BaseName, ".") - 1)
  
  
    nomfichier = Application.GetSaveAsFilename( _
                                               InitialFileName:=wbdest.Path & "\" & BaseName & "_MAJ_" & Format(Date, "yyyy_mm_dd") & ".xlsm", _
                                               filefilter:="Excel Files (*.xlsm), *.xlsm", _
                                               Title:="Enregistrer le fichier CIBLE sous...")
  
     If nomfichier <> "Faux" Then
        Application.DisplayAlerts = False
        wbdest.SaveAs Filename:=nomfichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.DisplayAlerts = True
        MsgBox "Fichier enregistré sous :" & vbCrLf & nomfichier, vbInformation
    Else
        MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
    End If

testé et éprouvé😉

faire la différence entre les deux
1° Application.FileDialog(msoFileDialogSaveAs)
2° Application.GetSaveAsFilename

Patrick

Electronull · Mercredi à 21:25

Nicolas JACQUIN à dit:

Bonjour,
à tester,

VB:

With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Enregistrer le fichier CIBLE sous..."
    .InitialFileName = wbDest.Path & "\" & baseName & "_MAJ_" & Format(Date, "yyyy_mm_dd") & ".xlsm"

    ' Ajoute les filtres : ici uniquement .xlsm
    .Filters.Clear
    .Filters.Add "Classeur Excel avec macros (*.xlsm)", "*.xlsm"
    .FilterIndex = 1  ' applique ce filtre par défaut

    If .Show = -1 Then
        nomFichier = .SelectedItems(1)

        If LCase$(Right$(nomFichier, 5)) <> ".xlsm" Then
            nomFichier = nomFichier & ".xlsm"
        End If

        Application.DisplayAlerts = False
        wbDest.SaveAs Filename:=nomFichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.DisplayAlerts = True

        MsgBox "Fichier enregistré sous :" & vbCrLf & nomFichier, vbInformation
    Else
        MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
    End If
End With

Nicolas

Salut,
Merci pour le bout de code, mais j'ai une erreur sur le .Filters.clear

patricktoulon · Mercredi à 21:30

allez c'est kado
voici la même avec la possibilité de choisir le type (3 filtres)
l'estension par defaut etant le premier

VB:

 Dim nomfichier As String
    Set wbdest = ThisWorkbook
    ' --- SAVE AS .xlsm ---
    BaseName = wbdest.Name
    If InStrRev(BaseName, ".") > 0 Then BaseName = Mid(BaseName, 1, InStrRev(BaseName, ".") - 1)
    
    
    nomfichier = Application.GetSaveAsFilename( _
                                               InitialFileName:=wbdest.Path & "\" & BaseName & "_MAJ_" & Format(Date, "yyyy_mm_dd") & ".xlsm", _
                                               filefilter:="Classeur macro (*.xlsm), *.xlsm, Classeur sans macro(*.xlsx),*.xlsx, Classeur binnaire (*.xlsb),*.xlsb", _
                                               Title:="Enregistrer le fichier CIBLE sous...")
    
    If nomfichier <> "Faux" Then
        Application.DisplayAlerts = False
        wbdest.SaveAs Filename:=nomfichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.DisplayAlerts = True
        MsgBox "Fichier enregistré sous :" & vbCrLf & nomfichier, vbInformation
    Else
        MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
    End If

démonstration

Electronull · Mercredi à 21:30

patricktoulon à dit:

Bonjour
je te propose le dialog autre que celui de l'application il est plus simple et moins retord que celui de l'application.fildialog

voici ton code repris

VB:

 ' --- SAVE AS .xlsm ---
     BaseName = wbdest.Name
    If InStrRev(BaseName, ".") > 0 Then BaseName = Mid(BaseName, 1, InStrRev(BaseName, ".") - 1)
 
 
    nomfichier = Application.GetSaveAsFilename( _
                                               InitialFileName:=wbdest.Path & "\" & BaseName & "_MAJ_" & Format(Date, "yyyy_mm_dd") & ".xlsm", _
                                               filefilter:="Excel Files (*.xlsm), *.xlsm", _
                                               Title:="Enregistrer le fichier CIBLE sous...")
 
     If nomfichier <> "Faux" Then
        Application.DisplayAlerts = False
        wbdest.SaveAs Filename:=nomfichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.DisplayAlerts = True
        MsgBox "Fichier enregistré sous :" & vbCrLf & nomfichier, vbInformation
    Else
        MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
    End If

testé et éprouvé😉

faire la différence entre les deux
1° Application.FileDialog(msoFileDialogSaveAs)
2° Application.GetSaveAsFilename

Patrick

Bonsoir patricktoulon,

Marche super, toujours au taquet.
Je vais regarder ça d'un peu plus près pour pouvoir le réutiliser.
Merci et bonne soirée.

Nicolas JACQUIN · Mercredi à 21:32

VB:

' --- SAVE AS .xlsm (via GetSaveAsFilename) ---
Application.DisplayAlerts = True   ' réactive les alertes pour le dialogue

Dim baseName As String, nomFichier As Variant
baseName = wbDest.Name
If InStrRev(baseName, ".") > 0 Then baseName = Left$(baseName, InStrRev(baseName, ".") - 1)

nomFichier = Application.GetSaveAsFilename( _
    InitialFileName:=wbDest.Path & "\" & baseName & "_MAJ_" & Format(Date, "yyyy_mm_dd") & ".xlsm", _
    FileFilter:="Classeur Excel avec macros (*.xlsm), *.xlsm", _
    Title:="Enregistrer le fichier CIBLE sous..." _
)

If nomFichier <> False Then
    If LCase$(Right$(CStr(nomFichier), 5)) <> ".xlsm" Then nomFichier = CStr(nomFichier) & ".xlsm"
    Application.DisplayAlerts = False
    wbDest.SaveAs Filename:=CStr(nomFichier), FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True
    MsgBox "Fichier enregistré sous :" & vbCrLf & CStr(nomFichier), vbInformation
Else
    MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
End If

ou bonus

Code:

Dim baseName As String, p As String
Dim choix As Variant, fmt As XlFileFormat

baseName = wbDest.Name
If InStrRev(baseName, ".") > 0 Then baseName = Left$(baseName, InStrRev(baseName, ".") - 1)
p = wbDest.Path & "\" & baseName & "_MAJ_" & Format(Date, "yyyy_mm_dd")

choix = Application.GetSaveAsFilename( _
    InitialFileName:=p & ".xlsm", _
    FileFilter:="Classeur Excel avec macros (*.xlsm), *.xlsm,Classeur Excel (*.xlsx), *.xlsx,Classeur Excel 97-2003 (*.xls), *.xls", _
    Title:="Enregistrer le fichier CIBLE sous..." _
)

If choix <> False Then
    Dim f As String: f = LCase$(CStr(choix))
    If Right$(f, 5) = ".xlsm" Then
        fmt = xlOpenXMLWorkbookMacroEnabled
    ElseIf Right$(f, 5) = ".xlsx" Then
        fmt = xlOpenXMLWorkbook
    ElseIf Right$(f, 4) = ".xls" Then
        fmt = xlExcel8
    Else
        ' Par défaut, force .xlsm si aucune extension reconnue
        f = f & ".xlsm": fmt = xlOpenXMLWorkbookMacroEnabled
    End If

    Application.DisplayAlerts = False
    wbDest.SaveAs Filename:=f, FileFormat:=fmt
    Application.DisplayAlerts = True
    MsgBox "Fichier enregistré sous :" & vbCrLf & f, vbInformation
Else
    MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
End If

Electronull · Mercredi à 21:38

Merci à vous deux pour le code.

C'est nickel.

Bonne soirée.

patricktoulon · Mercredi à 21:46

j'ajouterais et cela pour vous deux que le ".xlsm" est inutile avec getsavefilename
pour la simple et bonne raison que l'extension est la première pas defaut
donc @Nicolas JACQUIN ceci
If LCase$(Right$(CStr(nomFichier), 5)) <> ".xlsm" Then nomFichier = CStr(nomFichier) & ".xlsm"
est inutile

par contre oui j'avais oublié de changer le type dans le save as
mais il se fait par rapport au ".xlsx" ou autres

VB:

Sub saveAs()
    Dim nomfichier As String, forme&
    Set wbdest = ThisWorkbook
    ' --- SAVE AS .xlsm ---
    BaseName = wbdest.Name
    If InStrRev(BaseName, ".") > 0 Then BaseName = Mid(BaseName, 1, InStrRev(BaseName, ".") - 1)
  
  
    nomfichier = Application.GetSaveAsFilename( _
                                               InitialFileName:=wbdest.Path & "\" & BaseName & "_MAJ_" & Format(Date, "yyyy_mm_dd"), _
                                               filefilter:="Classeur macro (*.xlsm), *.xlsm, Classeur sans macro(*.xlsx),*.xlsx, Classeur binnire (*.xlsb),*.xlsb", _
                                               Title:="Enregistrer le fichier CIBLE sous...")
  
    If nomfichier <> "Faux" Then
        If Right(nomfichier, 5) <> ".xlsx" Then forme = xlOpenXMLWorkbookMacroEnabled Else forme = xlOpenXMLWorkbook
        Application.DisplayAlerts = False
        wbdest.SaveAs Filename:=nomfichier, FileFormat:=forme
        Application.DisplayAlerts = True
        MsgBox "Fichier enregistré sous :" & vbCrLf & nomfichier, vbInformation
    Else
        MsgBox "Enregistrement annulé : le classeur cible reste ouvert sans sauvegarde.", vbExclamation
    End If
 End Sub

vous pouvez constater que dans le initialfilename je ne met pas l'extension
pourtant à l'affichage vous l'aurez
patrick
maintenant elle est complète

patricktoulon · Hier à 22:09

re:
juste en passant vous avez un descriptif ici

Discussion 'la boite de dialog Application.GetsaveFilename'

Hier à 10:06

Bien utiliser le dialog (Application.GetSaveAsFilename)
par patricktoulon

Bonjour a tous
la demande étant apparue plusieurs fois cette année ,je vous propose un mini tuto sur ce dialog

La fonction "Application.GetSaveAsFilename" permet d’ouvrir une boîte de dialogue
d’enregistrement de fichier, sans pour autant enregistrer réellement.
Elle retourne uniquement le chemin du fichier choisi par l’utilisateur.

----------------------------------------------------
Syntaxe de base :
----------------------------------------------------...

XL 2019 Boite de dialogue Save as affiche mauvaise extension

Electronull

XLDnaute Junior

Nicolas JACQUIN

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Electronull

XLDnaute Junior

patricktoulon

XLDnaute Barbatruc

Electronull

XLDnaute Junior

Nicolas JACQUIN

XLDnaute Accro

Electronull

XLDnaute Junior

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussion 'la boite de dialog Application.GetsaveFilename'

Discussions similaires

XL 2019 Boite de dialogue Save as affiche mauvaise extension

XLDnaute Junior

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Accro

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency