Boite dialogue enregistrer sous et nom fichier

**HIGGUINS** · 12/07/2013, 14h49

Bonjour,

J'ai un code qui me permet d'enregistrer mon fichier avec un nom en fonction de plusieurs cellules, dans un dossier qui lui aussi est défini par une cellule. Si le dossier n'existe pas, il me le crée.

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
Private Sub Enregistrer_Click()
 
Dim Chemin As String
Dim mondossier As String
Dim Fichier As String
 
' Nom du chemin
Chemin = "C:\...\Essai devis\"
 
'Nom du dossier
mondossier = Range("J6").Value
 
'nom du fichier
Fichier = Range("J6") & " " & Format(Range("F2"), "00") & " " & Format(Range("G2"), "00") & " " & Format(Range("H2"), "000") & " " & Format(Range("I2"), "000") & ".xlsm"
 
'teste de la présence du dossier
If Dir(Chemin & mondossier, 16) = "" Then MkDir Chemin & mondossier
 
ActiveWorkbook.SaveAs Chemin & mondossier & "\" & Fichier

Maintenant, je souhaiterai avant qu'il enregistre me faire apparaitre la boite de dialogue "Enregistrer sous" dans le dossier de destination avec le nom du fichier pré-rempli.

Est ce que quelqu'un peu m'aider. Je n'y arrive pas.

**Marc-L** · 12/07/2013, 16h28

Pourquoi ouvrir un nouveau sujet ?

Si tu ne vérifies pas ce que l'on te demande, bon courage …

**HIGGUINS** · 12/07/2013, 16h37

Re,

Je ne fais que ça. Je n'arrête pas de chercher la solution sur les différents forum qu'il peut existait avec les indice que vous me fournissez. Je n'arrête pas d'essayer adapter vos codes avec mon existant. Cela ne marche pas, je ne trouve pas.

**parmi** · 12/07/2013, 17h06

Bonjour,

Tu devrais suivre les conseils de Marc_L et ne pas ouvrir un autre sujet pour le même problème...

Voici 2 méthodes qui fonctionnent très bien, comme déjà expliquées...
Essaie-les seules telles quelles

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
Sub UneMethode()
    Dim Chemin As String, MonDossier As String, Fichier As String
 
    Chemin = "C:\"
    MonDossier = "Temp\"
    Fichier = "Test.xlsm"
 
    ChDrive "C:"
    ChDir Chemin & MonDossier
 
    With Application.FileDialog(msoFileDialogSaveAs)
        .InitialFileName = Fichier
        .Show
    End With
 
End Sub
 
Sub UneAutre()
    Dim Chemin As String, MonDossier As String, Fichier As String
 
    Chemin = "C:\"
    MonDossier = "Temp\"
    Fichier = "Test.xlsm"
 
    ChDrive "C:"
    ChDir Chemin & MonDossier
 
    Application.GetSaveAsFilename Fichier, "Fichiers Excel (*.xls*), *.xls*"
End Sub

**Marc-L** · 15/07/2013, 11h06

.InitialFileName = Chemin & MonDossier & Fichier (sans les lignes n°8 & 9) …

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**HIGGUINS** · 15/07/2013, 17h07

Bonjour,

Parmi, merci pour ton aide et j'ai pu avancé. J'ai essayé les deux solutions proposées :
- la première ne marche pas => Il m'ouvre la boite de dialogue "Enregistrer"
- la 2ème => m'ouvre la boite de dialogue "Enregistrer sous" dans le dossier de destination (

) et le nom du fichier apparaît - Mais le fichier n'est pas sauvegardé.

Ci-dessous le code modifié à mon cas et j'ai supprimé à la fin du nom de mon fichier .xlsm" car sinon il ne prenait pas le nom du fichier :

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
Private Sub Enregistrer_Click()
 
Dim Chemin As String
Dim mondossier As String
Dim Fichier As String
 
' Nom du chemin
Chemin = "C:\....\Essai devis\"
 
'Nom du dossier
mondossier = Range("J6").Value
 
'nom du fichier
Fichier = Range("J6") & " " & Format(Range("F2"), "00") & " " & Format(Range("G2"), "00") & " " & Format(Range("H2"), "000") & " " & Format(Range("I2"), "000") & "
 
'teste de la présence du dossier
If Dir(Chemin & mondossier, 16) = "" Then MkDir Chemin & mondossier
 
ChDrive "C:"
ChDir Chemin & mondossier
 
Application.GetSaveAsFilename Fichier, "Fichier xlsm (*.xlsm*), *.xlsm*"
 
End Sub

Marc-L, je suis désolé mais toujours même réponse : La boite de dialogue "Enregistrer sous" ne s'ouvre pas dans le dossier de destination, et si je met ce code :

Code :

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

1
2
With Application.FileDialog(msoFileDialogSaveAs)
 .InitialFileName = Chemin & mondossier & Fichier

Il me marque en nom de fichier : 2 fois le nom du dossier + le nom de mon fichier.

**grisan29** · 15/07/2013, 21h49

bonsoir HIGGUINS,Marc-L,parmi et le forum

est ce que ceci irais bien a ta demande HIGGUINS

http://www.developpez.net/forums/d11...ur-par-msgbox/

Pascal

**HIGGUINS** · 16/07/2013, 12h04

Bonjour,

Merci pour cette proposition mais je voudrais faire apparaître la boite de dialogue avant l'enregistrement. Comme ça, je laisse à l'utilisateur le choix de modifier le contenu du nom du fichier proposé par défaut.
Avec ce bout de code, j'arrive à avoir la boite de dialogue qui s'ouvre dans le dossier de destination avec le nom du fichier proposé par défaut et l'enregistrement :

Code :

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

1
2
3
4
5
6
7
ChDrive "C:"
ChDir Chemin & mondossier
 
Application.GetSaveAsFilename Fichier, "Fichier xlsm (*.xlsm*), *.xlsm*"
ActiveWorkbook.SaveAs Filename:=Fichier
 
End Sub

Mais si je viens à modifier le nom du fichier proposé par défaut, il ne retient pas lors de l'enregistrement ma modification.

**Marc-L** · 16/07/2013, 12h23

Bonjour,

normal vu le nom tapé en retour non retenu ‼

Rien qu'en lisant l'aide intégrée de VBA et l'exemple concernant la méthode GetSaveAsFilename …

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

__________________________________________________________________________________________
Des chercheurs qui cherchent, on en trouve. Des chercheurs qui trouvent, on en cherche ! (Charles De Gaulle)

Invité · 16/07/2013, 13h11

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
Type OPENFILENAME
    nStructSize As Long
    hwndOwner As Long
    hInstance As Long
    sFilter As String
    sCustomFilter As String
    nCustFilterSize As Long
    nFilterIndex As Long
    sFile As String
    nFileSize As Long
    sFileTitle As String
    nTitleSize As Long
    sInitDir As String
    sDlgTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExt As Integer
    sDefFileExt As String
    nCustDataSize As Long
    fnHook As Long
    sTemplateName As String
End Type
Dim FileInfo As OPENFILENAME
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Sub test()
Dim t As String
t = SaveFile("toto.xls", ".xls", "toto", "toto")
End Sub
Function SaveFile(FileName$, FileExt$, FileDesc$, WinTitle$) As String
 
 
    Dim strCurName As String
    Dim strFill, strFilter As String
    Dim lngReturn, ShortSize As Long
 
 
'    On Error GoTo Err_Control
    strCurName = FileName$
 
 
    strFill = Chr(0)
    FileInfo.nStructSize = Len(FileInfo)
    FileInfo.hwndOwner = GetDesktopWindow
 
 
    'This section is for the filter drop down list
    strFilter = FileDesc$ & strFill & FileExt$ & strFill
    strFilter = strFilter & "All Files" & strFill & "*.*" & strFill & strFill
    FileInfo.sFilter = strFilter
    'This is the default information for the dialog
    FileInfo.sFile = FileName$ & Space$(1024) & strFill
    FileInfo.nFileSize = Len(FileInfo.sFile)
    FileInfo.sDefFileExt = FileExt$
 
 
    FileInfo.sFileTitle = Space(512)
    FileInfo.nTitleSize = Len(FileInfo.sFileTitle)
    FileInfo.sInitDir = CurDir
    FileInfo.sDlgTitle = WinTitle$
 
 
    ' use below to call save dialog
    FileInfo.flags = OFS_FILE_SAVE_FLAGS
    lngReturn = GetSaveFileName(FileInfo)
 
 
    If lngReturn Then
        SaveFile = FileInfo.sFile
    End If
 
 
    On Error GoTo 0
    Exit Function
 
 
Err_Control:
    'Just get out, to many things to account for
    MsgBox Err.Description, vbCritical, "Too many errors, aborting"
End Function

**parmi** · 16/07/2013, 17h30

Tu peux essayer comme ceci

Code :

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

1
2
    Fichier = Application.GetSaveAsFilename(Fichier, "Fichiers Excel (*.xlsm), *.xlsm")
    ActiveWorkbook.SaveAs Fichier

De cette façon, tu affiches le nom du fichier original, par contre tu refiles le nom changé à la même variable au cas où le nom aurait été modifié.

**HIGGUINS** · 17/07/2013, 15h52

SUPER SUPER SUPER MERCI PARMI. J'ai bien fait d'ouvrir un autre post.

Ca marche

Comme je le souhaitais. Enfin résolu.

**parmi** · 17/07/2013, 17h04

Bien content pour toi.
Prends le temps de cliquer le bouton Résolu pour aider ceux qui font des recherches...

**Marc-L** · 17/07/2013, 17h23

Envoyé par HIGGUINS

J'ai bien fait d'ouvrir un autre post.

Ben non vu que cette solution t'a déjà été donnée dans ton sujet précédent il y a deux semaines ‼

__________________________________________________________________________________________
Quand on est mort, on ne sait pas qu'on est mort, c'est pour les autres que c'est difficile … Quand on est con, c'est pareil ‼

Boite dialogue enregistrer sous et nom fichier [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager