Macro pour sauvergarder sous avec le nom d'une celluleFermé

Question

Bonjour, 

Je souhaiterais faire une macro permettant d'ouvrir la boite de dialogue de "sauvegarder sous excel prenant en compte les macros" et que dans la plage "nom du fichier de cette boite de dialogue apparaissent le la valeur d'une cellule du classeur à enregistrer. Ceci de façon à ce que l'utilisateur ai juste à choisir où il veut enregistrer son fichier et sauvergarder.

Merci d'avance, 

Bonne journée



Configuration: Windows 7 / Internet Explorer 9.0

vtp · Answer

Bonjour,

A supposer que le nom de fichier à récupérer soit en A1, insérer la macro suivante dans un module en changeant le chemin à votre convenance

Sub Sauvegarder()

nomfichier = ActiveSheet.Cells(1, 1).Value
chemin = "C:\Documents and Settings\Utilisateur\Mes documents\"
    Z = chemin & nomfichier & ".xlsm"
    ActiveWorkbook.SaveAs Filename:= _
 Z, FileFormat:= _xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

Si l'utilisateur peux avoir plusieurs choix il faut faire une liste de choix en A1

En espérant que cela correspond à ce que vous vouliez

Patrice33740 · Answer

Bonjour,

Essaies ce code :

Sub EnregistrerAvecNom()
'Enregistrer avec le nom situé dans une cellule
Dim rèpDialogue As Variant         'Réponse de la boite de dialogue Excel
Dim cel As Range                   'Cellule contenant le nom du fichier
Dim nomFichier As String           'Nom du fichier (contenu dans la cellule)
Dim nomSaisi As String             'Nom de fichier saisi 
Dim txt As String                  'Titre de la boite de message
Dim msg As String                  'Message pour boite de message
Dim rép As Integer                 'Réponse à une boite de message

 
'Cellule contenant le nom
Set cel = Worksheets(1).Range("A1")
'Nom du fichier
If cel.Formula > "" And TypeName(cel.Value) = "String" Then
  nomFichier = cel.Value & " " & Format(Date, "yyyy-mm-dd") & ".xls"
Else
  nomFichier = "Sans nom " & Format(Date, "yyyy-mm-dd") & ".xls"
End If

'Proposer l'enregistrement
txt = "Enregistrer le fichier avec le nom dans une cellule"
Do
  rèpDialogue = Application.GetSaveAsFilename(nomFichier)
  If rèpDialogue = False Then
    Exit Sub
  End If
  nomSaisi = StrReverse(rèpDialogue)
  nomSaisi = StrReverse(Mid(nomSaisi, 1, InStr(1, nomSaisi & "\", "\") - 1))
  If nomSaisi <> nomFichier Then
    msg = "Confirmer le remplacement du nom," & vbCr & _
          "normalement prévu pour ce classeur :" & vbCr & _
          nomFichier & vbCr & vbCr & _
          "par le nom qui vient d'être saisi :" & vbCr & _
          nomSaisi
    rép = MsgBox(msg, vbExclamation + vbOKCancel, txt)
    If rép = vbOK Then nomFichier = nomSaisi
  End If
Loop While nomSaisi <> nomFichier
On Error GoTo ErrorHandler
ActiveWorkbook.SaveAs Filename:=nomFichier
On Error GoTo 0

Exit Sub

ErrorHandler:          'Routine de gestion d'erreur.
'------------
'Évalue le numéro d'erreur.
Select Case Err.Number
  Case 1004
    'Le fichier 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, txt
      Resume Next
    End If
  Case Else
    MsgBox Err.Description, vbCritical, txt
    Stop
    Resume Next
End Select

End Sub

cpaumier · Answer

Merci beaucoup pour vos réponses si rapide.

J'ai finalement réussi avec ça :

ChDir "Z:\"
ActiveWorkbook.SaveAs Filename:=Application.GetSaveAsFilename("toto", fileFilter:="Excel Files (*.xlsm), *.xlsm")

Bonne journée

Macro pour sauvergarder sous avec le nom d'une cellule

3 réponses

Newsletters