Sauvegarder fichier Excel sans l'ouvrir

Le 07/06/2017 à 23:32

salut

la macro suivante (placée dans un module) sauvegarde mon classeur entier sous un autre nom selon valeur cellule A1.

le problème c'est que le nouveau fichier sauvegardé s'ouvre également.

Comment modifier la macro afin que le classeur se sauvegarde sous un nouveau nom sur le bureau, mais sans l'ouvrir automatiquement ?

Sub Bevel1_Click()

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim S As Shape

Dim sNomFic As String, sRep As String, WshShell As Object

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

' Crיer une instance Windows Script pour retrouver le chemin du bureau

Set WshShell = CreateObject("WScript.Shell")

sRep = WshShell.SpecialFolders("Desktop")

Set WshShell = Nothing

' Definit le nom du fichier a enregistrer

sNomFic = Sheets("nom onglet").Range("A1").Value & ".xls"

' Enregistrer la feuille sous excel

wk1 = ThisWorkbook.FullName

ActiveWorkbook.SaveAs Filename:=sRep & "\" & sNomFic, FileFormat:=56, CreateBackup:=False

Workbooks.Open Filename:=wk1

MsgBox "the file has been saved on your desktop"

'Sheets("nom onglet").PrintOut

End Sub

Le 08/06/2017 à 02:35

Bonjour ericw

je pense que c'est cette ligne qui fait ouvrir le classeur sauver

Workbooks.Open Filename:=wk1

mets la en commentaire pour essayer

Le 08/06/2017 à 05:14

Bonjour,

à tester

'..............................
wk1 = ThisWorkbook.FullName
ActiveWorkbook.SaveAs Filename:=sRep & "\" & sNomFic, FileFormat:=56, CreateBackup:=False
ActiveWorkbook.Close
Workbooks.Open Filename:=wk1
'..............................
Le 08/06/2017 à 08:10

merci bcp!! ca fonctionne!!!

une autre question SVP, j'espere que ce n'est pas trop complique, sinon tant pis.

Le code sauvegarde le classeur sous un autre nom (selon valeur cellule A1).

ile le sauvegarde automatiquement sur le bureau. est ce possible d'ouvrir la fenetre qui demande ou on veut sauvegarder, mais en meme temps que le nom du nouveau fichier apparaissent dans la ligne "nom fichier" de la fenetre de sauvegarde ?

Le 08/06/2017 à 12:29

Bonjour,

à tester,

wk1 = ThisWorkbook.FullName

With Application.FileDialog(msoFileDialogSaveAs)
        .FilterIndex = 4
        .InitialFileName = sRep & "\" & sNomFic
        .AllowMultiSelect = False
        .Show
        If .Show = -1 Then
            ActiveWorkbook.SaveAs Filename:=.SelectedItems(1)
        End If
End With

ActiveWorkbook.Close
Workbooks.Open Filename:=wk1
Le 09/06/2017 à 20:43

c'est presque parfait mais quand je clique sur "sauvegarder" dans la fenetre "save as", ça ouvre encore une fois la même fenêtre.

Pourquoi la fenêtre de sauvegarde apparaît-elle 2 fois de suite?

Le 09/06/2017 à 21:02

pouvez-vous joindre votre fichier ?

Le 09/06/2017 à 23:19

Bonjour,

essaie en ajoutant après le saveas :

ActiveWorkbook.Saved = True

eric

Le 10/06/2017 à 00:19

bonsoir !

merci pour vos reponses!

je joins un fichier.

quand on appuie sur le bouton, vous devez deux fois de suite appuyer sur "save as" dans la fenetre (qui s'ouvre 2 fois) afin de sauvegarder le classeur.

73book1.xlsm (22.01 Ko)
Le 10/06/2017 à 07:56

Bonjour,

et as-tu testé ce que je te proposais ??

eric

Le 10/06/2017 à 12:22

bonjour Eriiic

oui, bien sûr, j'ai mis la ligne que tu m'as proposé, mais je ne suis pas certain que je l'ai mis au bon endroit....

tu peux le voir dans le code dans le fichier joint.

Le 10/06/2017 à 13:03

Bonjour,

C'est quoi ce test

If .Show ...

?

Tu as déjà fait .show au-dessus et là tu le refais. Il te ré-affiche donc la fenêtre de sauvegarde.

Pour choisir un répertoire tu peux faire ça :

    Dim Repertoire As FileDialog
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MsgBox Repertoire.SelectedItems(1)

ensuite tu sauvegarde dans celui choisi : Repertoire.SelectedItems(1)

eric

Le 10/06/2017 à 13:59

la macro suivante fonctionne.

Je parviens à ouvrir une fenêtre de sauvegarde avec le nom du fichier déjà inscrit.

Le seul problème est le suivant:

si je clique dans la fenêtre de sauvegarde sur "cancel" ça fait un bug. (en cliquant sur "save" tout fonctionne)

comment faire afin que si je clique dans la fenêtre sur le bouton cancel, la macro s'arrête et ne sauvegarde rien?

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim S As Shape

Dim sNomFic As String, sRep As String, WshShell As Object

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

' Créer une instance Windows Script pour retrouver le chemin du bureau

Set WshShell = CreateObject("WScript.Shell")

sRep = WshShell.SpecialFolders("Desktop")

Set WshShell = Nothing

' Définit le nom du fichier à enregistrer

sNomFic = Sheets("äñáø çùáåðéú").Range("A1").Value & ".xls"

' Enregistrer la feuille sous excel

wk1 = ThisWorkbook.FullName 'pour enregistrer via fenetre save as

With Application.FileDialog(msoFileDialogSaveAs)

.FilterIndex = 4

.InitialFileName = sRep & "\" & sNomFic

.AllowMultiSelect = False

.Show

ActiveWorkbook.SaveAs Filename:=.SelectedItems(1)

ActiveWorkbook.Saved = True

End With

Application.Quit

Le 10/06/2017 à 18:48

c'est sympa de faire des retours à chaque fois, on a moins l'impression de parler dans le vent.

Bon, je te laisse à ton monologue et vais voir des demandeurs plus civilisés...

Le 14/06/2017 à 04:59

Bonjour à tous,

ericw, d'après la macro sur le fichier que tu as joint,

à tester,

Sub Bevel1_Click()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim sNomFic As String, sRep As String, WshShell As Object

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

wk1 = ThisWorkbook.FullName    'nom du fichier original

' Créer une instance Windows Script pour retrouver le chemin du bureau
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("Desktop")
Set WshShell = Nothing

sNomFic = Sheets("sheet1").Range("A1").Value & ".xls" ' Définit le nom du fichier à enregistrer

With Application.FileDialog(msoFileDialogSaveAs)
        .FilterIndex = 4
        .InitialFileName = sRep & "\" & sNomFic
        .AllowMultiSelect = False
        .Show
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

ActiveWorkbook.Close
Workbooks.Open Filename:=wk1
End Sub

aussi à vérifier: avez-vous les droit pour enregistrer sur "Desktop"

Rechercher des sujets similaires à "sauvegarder fichier ouvrir"