SauverFeuilleDossierChoisi

Retour vers Excel

Choisir un dossier pour la sauvegarde de la feuille active en la recopiant dans un fichier sans les autres feuilles

But : Tout est dans le titre - alors qu'est ce qui veut le monsieur ?

Situation de départ classique, j'ai un classeur avec 3 feuilles, dont une a été renommée

Seule la feuille "Hello" m'intéresse , les feuilles "Sheet2" et "Sheet3" ne m'intéresse pas, elles sont vides par exemple
Je vais donc la recopier dans un nouveau classeur et la sauver suivant 2 méthodes différentes

1. en faisant apparaître la boîte de dialogue de sauvegarde de fichier avec le code suivant :

   Sub CopieSauvegarde()
     ActiveSheet.Copy ' crées le nouveau fichier
     Application.Dialogs(xlDialogSaveAs).Show ' montre la boîte de dialogue
   End Sub

   J'obtiens alors la fenêtre suivante, il me reste à donner un nom au fichier

   

    

2. On peut aller plus loin, en utilisant une autre boîte de dialogue et en sauvant le fichier sous un nom que l'on construit à partir du nom de la feuille. C'est assez mnémotechnique comme procédé et ceci avec le code

   Option Explicit
   --------------------------
   Public Type BROWSEINFO
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
   End Type
   
   '32-bit API declarations
   Declare Function SHGetPathFromIDList Lib "shell32.dll" _
   Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
   Declare Function SHBrowseForFolder Lib "shell32.dll" _
   Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
   
   Function GetDirectory(Optional Msg) As String
   Dim bInfo As BROWSEINFO
   Dim path As String, Dossier As String
   Dim r As Long, x As Long, pos As Integer
   bInfo.pidlRoot = 0&
   If IsMissing(Msg) Then
   bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
   Else
   bInfo.lpszTitle = Msg
   End If
   bInfo.ulFlags = &H1
   x = SHBrowseForFolder(bInfo)
   path = Space$(512)
   r = SHGetPathFromIDList(ByVal x, ByVal path)
   If r Then
   pos = InStr(path, Chr$(0))
   GetDirectory = Left(path, pos - 1)
   Dossier = GetDirectory & ""
   Else
   GetDirectory = ""
   End If
   End Function

   Sub LancerSauvegarde()
      Dim reponse As String
      reponse = GetDirectory
      ActiveSheet.Copy 'fais la copie de la feuille active
      ActiveSheet.SaveAs (reponse & "\" & ActiveSheet.Name)
   End Sub

3. Je ne vous cache pas que je me suis largement inspiré de la page d' Excelabo qui eux-mêmes l'ont empruntée à John Walkenbach

Mais qu'est ce qu'on en fait ? il nous suffit de lancer la macro intitulée "LancerSauvegarde" et de pointer le répertoire souhaité dans la boîte de dialogue qui apparaît et qui ressemble à ceci - le flou en moins 🙂

Cliquez ici pour télécharger le fichier exemple SauvegardeAvecRepertoire

FIN