Proposer u nom de fichier au moment de l'enregistrement

Sly le globe trotter · 7 Septembre 2006

Proposer un nom de fichier au moment de l'enregistrement

Bonjour tout le monde,

Je me posais une question... Lorsque l'on enregistre un fichier Excel, le logiciel va proposer un nom par défaut au fichier. Ce nom correspond soit au nom du fichier d'origine soit à Classeur1.xls pour un nouveau fichier.

Est-il possible de proposer un nom de fichier via VBA ?

Merci pour votre aide
Sly

Sly le globe trotter · 8 Septembre 2006

Re : Proposer un nom de fichier au moment de l'enregistrement

Bonjour le forum,

Je me permets de relancer le post🙄
J'espère que personne ne m'en voudra mais je n'arrive pas à trouver de solution...

J'ai tenté en utilisant la fonction BeforeSave mais je n'arrive pas à faire ce que je veux... Peut on proposer un chemin et un nom au moment dans le fenêtre "Enregistrer sous" ?

Merci pour votre aide
Sylvain

MichelXld · 8 Septembre 2006

Re : Proposer u nom de fichier au moment de l'enregistrement

bonjour

tu peux essayer

Code:

ChDir ("C:\Documents and Settings\michel\dossier\general")
 
Application.Dialogs(xlDialogSaveAs).Show "monclasseur.xls"

bon week end
MichelXld

fredh · 8 Septembre 2006

Re : Proposer u nom de fichier au moment de l'enregistrement

ou alors tu peut te baser sur ce poste https://www.excel-downloads.com/threads/racourcir-code-vba-avec-goto.66656/ pour enregistrer le fichier avec un nom de fichier placer dans la celulle A3 (ou autre) et un repertoire donner par la celulle A4(ou autre).

Si cela t'interesse je peut t'eclairer sur le code final realiser avec l'aide de Pascal76).
Le code final propose de sauvegarder le fichier avec comme nom le contenu d'une celulle et comme repertoire le contenu d'une autre celulle. Avec bien sur gestions des erreur comme "pas de nom", "fichier existe deja" etc...
Moi j'ai stocker les module de code et les repertoire de destination dans un fichier (perso.xls) avec classeur caché qui se situe dans XLSTART. de cette manieres j'ai pu ajouter une icone dans la barre de menu et le code s'applique sur n'importe quelle fichier....
Pour mes repertoire j'utilise des racourcis dans les celulle, par exemple S1 et la condition pour sauvegarder dans le repertoire stocker en celulle A1 de perso.xls

Voila si cela t'interesse je met le fichier sur ce fil Lundi soir car je l'ai sur la becane du boulot...et le code sur le fil citer n'est pas en version final

Sly le globe trotter · 8 Septembre 2006

Re : Proposer u nom de fichier au moment de l'enregistrement

Bonjour MichelXD,

Je viens de tester ta méthode, celà fonctionne pour le nom de fichier mais pas pour le chemin.

De mon côté, j'étais parti sur la méthode BeforeSave

Code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If SaveAsUI Then
    Nom = Sheets("Demande").Range("m2")
    Dem = Sheets("Demande").Range("k3")
    ARangerds = Sheets("Demande").Range("g9")
    Ad = "P:\Tests\Tests laboratoire\Volants-Balles\"

    Chemin = Ad & ARangerds & "\"

    If Sheets("Demande").Range("k2") <> "" And Sheets("Demande").Range("g9") <> "" Then
        a = MsgBox("Bonjour " & Dem & ", la demande de test va être enregistrée dans le dossier suivant " & Chemin & Nom & ". Merci de compléter le 'n° de demande' et la partie 'Commentaires'", vbOKCancel)
        If a = vbCancel Then
            Cancel = True
        Else
            ActiveWorkbook.SaveAs Filename:=Chemin & Nom
        End If
    Else
        a = MsgBox("Veuillez svp renseigner le demandeur et le dossier d'enregistrement", vbOKOnly)
        If a = vbOK Then Cancel = True
    End If
End If

End Sub

L'inconvénient, c'est qu'avec cette solution, j'enregistre potentiellement deux fichiers... Un avec la commande ActiveWorkbook.SaveAs, puis un lorsque le Save s'éxécute.
Par contre, j'arrive bien à proposer un chemin et un nom pour le fichier à enregistrer.

Merci

Sly le globe trotter · 8 Septembre 2006

Re : Proposer u nom de fichier au moment de l'enregistrement

fredh à dit:
Si cela t'interesse je peut t'eclairer sur le code final realiser avec l'aide de Pascal76).

Voila si cela t'interesse je met le fichier sur ce fil Lundi soir car je l'ai sur la becane du boulot...et le code sur le fil citer n'est pas en version final

Avec plaisir !
Merci

chris · 9 Septembre 2006

Re : Proposer u nom de fichier au moment de l'enregistrement

Bonjour
J'ai complété le code du fichier que je t'avais envoyé sur le fil https://www.excel-downloads.com/threads/condition-de-saveas.66803/
selon les explications que je t'avais données.

Tu n'as plus qu'à ajouter le code de ton contrôle

Nom = Sheets("Demande").Range("m2")
Dem = Sheets("Demande").Range("k3")
ARangerds = Sheets("Demande").Range("g9")
Ad = "P:\Tests\Tests laboratoire\Volants-Balles\"
Chemin = Ad & ARangerds & "\"
If Sheets("Demande").Range("k2") <> "" And Sheets("Demande").Range("g9") <> ""

à l'endroit indiqué dans le workbook_beforesave et à adapter le chemin

Tiens-moi au courant.

Bon week end

fredh · 11 Septembre 2006

Re : Proposer u nom de fichier au moment de l'enregistrement

Bonsoir le fil

voila comme promis : le code pour enregistrer grace a un bouton en barre d'outil, le fichier par un nom contenu dans une celulle et un repertoire contenu dans une autre celulle.
Le bouton doit pointer vers le classeur "personl.xls", Macro : Save_As.

Ici dans l'exemple le nom se situe en A3, et le chemin en AA3 (pour le chemin je mets des racourcis ca m'evite de taper le chemein a chaque fois)

Les chemins et les module sont stocker dans un classeur qui serat toujour lancer avec excell mais que l'on mettra en cacher (dans excell menu fenetre puis masquer).
Le fichier s'apelle "Personl.xls" et est a placer dans "c:\Program Files\Microsoft Office\OFFICE11\XLSTART\" (pour office 2003 sinon changer office11 par Officexxx)

Dans un module de Personl.xls:

Code:

Public Erreur, Param, Desti As String

Dans un autre module de Personl.xls:

Code:

Sub Save_as()
desti = Sheets(1).Range("AA3").Value
If desti = "S1" Then
Fred_ ("A2") 'ici on lance la macro Fred avec passage du parametre : "A2"
End If
If desti = "S2" Then
Fred_ ("A3")
End If
If desti = "S3" Then
Fred_ ("A4")
End If
If desti = "S4" Then
Fred_ ("A5")
End If
If desti = "S5" Then
Fred_ ("A6")
End If
If desti = "S6" Then
Fred_ ("A7")
End If
If desti = "S7" Then
Fred_ ("A8")
End If
If desti = "S8" Then
Fred_ ("A9")
End If
If desti = "S9" Then
Fred_ ("A10")
End If
If desti = "S10" Then
Fred_ ("A11")
End If
If desti = "S11" Then
Fred_ ("A12")
End If
If desti = "S12" Then
Fred_ ("A13")
End If
If desti = "" Then
Erreur = "La celulle 'AA3' doit contenir une destination"
End If
If desti <> "" And desti <> "S1" And desti <> "S2" And desti <> "S3" _
    And desti <> "S4" And desti <> "S5" And desti <> "S6" And desti <> "S7" And _
    desti <> "S8" And desti <> "S9" And desti <> "S10" And desti <> "S11" And _
    desti <> "S12" Then
    Erreur = "Répèrtoire non identifié"
End If
If Erreur <> "" Then
CreateObject("WScript.Shell").Popup Erreur & vbLf & vbLf & vbLf & vbLf & _
"Voici le racourcis a rentrez dans la celulle 'AA3' pour les destinations :" & vbLf & vbLf & _
"S1  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A2")).Value & vbLf & _
"S3  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A3")).Value & vbLf & _
"S4  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A4")).Value & vbLf & _
"S5  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A5")).Value & vbLf & _
"S6  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A6")).Value & vbLf & _
"S7  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A7")).Value & vbLf & _
"S8  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A8")).Value & vbLf & _
"S9  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A9")).Value & vbLf & _
"S10  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A10")).Value & vbLf & _
"S11  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A11")).Value & vbLf & _
"S12  -->  " & Workbooks("Personl.xls").Sheets("destination").Range(("A12")).Value & vbLf _
, 2, "Gestion des erreurs"
End If
    Application.DisplayAlerts = True
    Erreur = ""
End Sub
Sub Fred_(MaCellule As String)
    Dim Fichier, Fichier_Origine, Path, Perso
 
    Perso = ActiveWorkbook.Name
    Fichier_Origine = ActiveWorkbook.FullName
    Fichier = Workbooks(Perso).Sheets(1).Range("A3").Value & ".xls"
    Path = Workbooks("Personl.xls").Sheets("Destination").Range(MaCellule).Value
 
    If Path = "" Then
       Erreur = "Aucun répèrtoire de mémoriser"
    Else
    If Sheets(1).Range("A3").Value = "" Then
       Erreur = "Aucun nom"
       Else
           If Fichier = Fichier_Origine Then
             Erreur = "Meme nom, meme répèrtoire"
           Else
             If Dir(Path & "\" & Fichier) = "" Then
                Workbooks(Perso).SaveAs Filename:=Path & Fichier
                'Kill Fichier_Origine ' ici on peut si l'ont veut effacer le fichier d'origine
                CreateObject("WScript.Shell").Popup "Nouveau fichier créer dans :" & _
                vbLf & vbLf & Path & vbLf & vbLf & vbLf & "Nom du fichier :  " & _
                Fichier & vbLf, 3, "Fred"
                Else
                Erreur = "le fichier existe déja dans le répèrtoire de déstination ..."
             End If
        End If
    End If
End If
End Sub

Merci Pascal76 qui a fait le gros du boulot...
Si tu as des questions n'hesite pas

Sly le globe trotter · 18 Septembre 2006

Re : Proposer u nom de fichier au moment de l'enregistrement

Mille mercis !
Cette méthode est géniale.

Bonne continuation

Proposer u nom de fichier au moment de l'enregistrement

Sly le globe trotter

XLDnaute Occasionnel

Sly le globe trotter

XLDnaute Occasionnel

MichelXld

XLDnaute Barbatruc

fredh

XLDnaute Occasionnel

Sly le globe trotter

XLDnaute Occasionnel

Sly le globe trotter

XLDnaute Occasionnel

chris

XLDnaute Barbatruc

Pièces jointes

fredh

XLDnaute Occasionnel

Pièces jointes

Sly le globe trotter

XLDnaute Occasionnel

Discussions similaires

Proposer u nom de fichier au moment de l'enregistrement

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency