Discussion :

[LaureneW]

Bonjour à tous,
J'aimerai sauvegarder mon fichier Excel en ouvrant une fenêtre "enregistrer sous" sous format "xlsm",
Actuellement j'ai ce code qui fonctionne bien, SAUF que l'utilisateur peut choisir n'importe quel format d'enregistrement (ce que je ne souhaite pas)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
'Pour enregistrer le fichier sous un nouveau nom et garder l'ancien
    Dim objSaveBox As FileDialog
    'Définit la fenêtre "Enregistrer sous"
    Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
    With objSaveBox
        'Définit un nom par défaut dans le champ "Nom de fichier".
        .InitialFileName = "Nom fichier.xlsm"
        .FilterIndex = 4
        .Show
        'Enregistre
        .Execute
    End With
    Unload Me

J'ai un autre code qui cette fois enregistre bien sous format xlsm mais ne m'ouvre pas la fenêtre d'enregistrer sous, or je voudrais que les utilisateurs puissent choisir eux même le chemin d'enregistrement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
        ActiveWorkbook.SaveAs Filename:=chemin & nomfichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=True

Je n'arrive pas à faire un mixte de ces deux codes pour que cela fonctionne, avez-vous des idées ?
Merci d'avance pour vos réponses !

[Patrice740]

Bonjour,

Le code tel que je l'utilise en général (à adapter à ton besoin) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Sub Test()
   Call ProposerEnregistrement("Mon Classeur")
End Sub
 
Public Sub ProposerEnregistrement(nomClasseur As String, Optional strChemin As String = "")
' Propose l'enregistrement d'un classeur
'
' Arguments : nomClasseur         [in]  Nom du classeur (sans extension)
'             strChemin           [in]  Chemin de destination (répertoire)
'
' 18/02/15    Patrice33740        V1-1-00  Création
'
Dim dlgSaveAs As FileDialog        'Boite de dialogue Office
Dim ext As String                  'Extension du classeur
Dim msg As String                  'Message pour boite de dialogue
Dim formule As String              'Formule de calcul
Dim rép As Integer                 'Réponse boite de dialogue
Dim idx As Integer                 'Index
 
  ext = ".xlsm"
  nomClasseur = nomClasseur & ext
  'Proposer l'enregistrement du classeur
  Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
  With dlgSaveAs
    ' nom du classeur
    If strChemin = "" Then
      .InitialFileName = ThisWorkbook.Path & "\" & nomClasseur
    Else
      .InitialFileName = strChemin & "\" & nomClasseur
    End If
    ' filtrer sur l'extension *.xls
    For idx = 1 To .Filters.Count
      If .Filters(idx).Extensions = "*" & ext Then
        .FilterIndex = idx
        Exit For
      End If
    Next idx
  End With
  Do
    ' afficher la boite de dialogue Enregistrer sous
    If dlgSaveAs.Show = 0 Then Exit Sub
    ' vérifier le nom du classeur
    formule = StrReverse(dlgSaveAs.SelectedItems.Item(1))
    formule = StrReverse(Mid(formule, 1, InStr(1, formule & "\", "\") - 1))
    If formule <> nomClasseur Then
      msg = "Confirmer le remplacement du nom normalement prévu : " & vbCr & _
            "«" & nomClasseur & "»" & vbCr & _
            "par le nom qui vient d'être saisi :" & vbCr & _
            "«" & formule & "»"
      rép = MsgBox(msg, vbExclamation + vbOKCancel)
      If rép = vbOK Then nomClasseur = formule
    End If
  Loop While formule <> nomClasseur
  'Enregistrer
  Application.ScreenUpdating = False
  On Error GoTo ErrorHandler
  Application.DisplayAlerts = False
  Application.EnableEvents = False
  dlgSaveAs.Execute
  Application.EnableEvents = True
  Application.DisplayAlerts = True
  On Error GoTo 0
  Application.ScreenUpdating = True
 
Exit Sub
 
ErrorHandler:          'Routine de gestion d'erreur.
Select Case Err.Number
  Case 1004
    'Le classeur est déjà ouvert ou l'enregistrement à été annulé
    If Err.Description = "La méthode 'SaveAs' de l'objet '_Workbook' a échoué" Then
      Resume Next
    Else
      MsgBox "L'enregistrement à échoué :" & vbCr & vbCr & Err.Description, vbInformation
      Resume Next
    End If
  Case Else
    MsgBox Err.Description, vbCritical
    Stop
    Resume Next
End Select
 
End Sub

[LaureneW]

Merci Patrice pour ta réponse rapide,
Cela fonctionne nickel, mais saurais-tu comment faire pour que la liste de choix des autres formats (cf ci dessous) n'apparaissent pas ? Autrement dire, pour que les utilisateurs ne puissent pas choisir un autre format (et pas seulement que xlsm soit le format par défaut)

[Patrice740]

Je ne sais pas si on peut interdire cette liste mais en adaptant les lignes 43 à 52, tu peux rejeter ce qui ne te convient pas (dont une extension inadéquate). D'autre part le save s'effectue à part donc tu peux utiliser le nom que tu veux.
Et sinon utilises une autre boite de dialogue (par exemple msoFileDialogFolderPicker), pour demander uniquement un répertoire

[patricktoulon]

tu a la possibilité d'utiliser un autre dialog aussi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Function enregistrer_sous_XLSM()
 
    fname = Application.GetSaveAsFilename(InitialFileName:=Environ("userprofile") & "\Desktop\" & ThisWorkbook.Name, filefilter:="Xlsm Files (*.xlsm), *.xlsm", Title:="ENREGISTREMENT DU CLASSEUR")
    enregistrer_sous_XLSM = fname
End Function
'
Sub TEST()
nom = enregistrer_sous_XLSM
If nom <> False Then ThisWorkbook.SaveAs (nom)
 ActiveWorkbook.SaveAs Filename:=nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

tu peux même taper .truc .machin .xls .ce quetuveux tu aura toujours ".xlsm" a la fin
et le choix des filtres est réduit a un seul "xlsm"


cela dit Attention que ce soit l'une ou l'autre de dialogue une fois remplie et lancée le fichier macro est fermé et c'est le fichier sauvé qui est a l'ecran
est ce bien ce que tu veux !!!??????

ne serait ce pas plutôt une copie de ce fichier sous un autre nom !!!!???????

[LaureneW]

Bonjour Patrick,
Merci pour ta réponse,
Oui, je veux en effet que ce soit le fichier sauvé qui apparaisse à l'écran
C'est top pour l'affichage de fichiers xlsm seulement, en revanche, la macro m'enregistre le fichier en amont, m'informe par la suite qu'un fichier du même nom existe déjà et si je clique sur "non" (cf image ci dessous), alors il y a un bug...

[patricktoulon]

ben c'est pas un bug c'est que le fichier existe
si tu essaie plusieurs fois le dialog avec le même nom c'est sur que tu aura le message
application.displayalerts=false en debut de sub si tu veux pas voir ce message

[patricktoulon]

re
Oupss!!autant pour moi

je faisait une répétition

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub TEST()
nom = enregistrer_sous_XLSM
If nom <> "" Then ActiveWorkbook.SaveAs Filename:=nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

[LaureneW]

Pourtant mon fichier n'existe pas sous le nom que je donne en enregistrement (J'ai bien vérifié)
Mais du coup avec application.displayalerts=false tout fonctionne parfaitement !
Encore une fois merci (à chaque fois, tes solutions données m'aident beaucoup )

[patricktoulon]

de rien sans la repetition tu n'a pas besoins du displays alerts

et surtout qu'avec le temps tu risque de plus te souvenir si un nom existe ou pas alors vaut mieux laisser l'alerte au cas ou

[LaureneW]

De nouveau moi !
Quand la fenêtre enregistrer sous s'affiche et que je clique sur "enregistrer", tout fonctionne.
En revanche, si je veux revenir en arrière et cliquer sur "annulez" ou la croix rouge en haut à droite, dans ces cas là mon fichier s’enregistre sous le nom FALSE (Or, j'aimerai qu'il ne s’enregistre tout simplement pas et que le fait de cliquer sur annuler, annule véritablement l'action de vouloir enregistrer).
Savez-vous comment régler ce problème ?

[LaureneW]

Si ça peut aider, voici le code final que j'ai :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Private Sub CommandButton1_Click()
    nom = enregistrer_sous_XLSM
    If nom <> "" Then
    ActiveWorkbook.SaveAs Filename:=nom, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Unload Me
End Sub
 
Function enregistrer_sous_XLSM()
    NDR = ActiveWorkbook.Path & "\" & nom_client
    FName = Application.GetSaveAsFilename(NDR & "Projet de vie " & nom_client & Format(Now(), "yyyymmdd_hhmm"), filefilter:="Xlsm Files (*.xlsm), *.xlsm", Title:="ENREGISTREMENT DU CLASSEUR")
    enregistrer_sous_XLSM = FName   
End Function