MsgBox pour choisir son emplacement d'enregistrement
Bonjour la Communauté Excel-Pratique,
Aujourd'hui encore je souhaiterais faire appel à vos connaissances et éventuellement une si possible.
J'ai mon code ci-dessous, qui me permet d'enregistrer un classeur excel en suivant les étapes d'une message Box.
Ce qui permet d'éditer soi-même le nom du fichier et de déterminer l'emplacement d'enregistrement et Cela pour plusieurs fichiers à la fois.
Mais le problème ce que quand je choisi mon répertoire d'emplacement, j'ai un message comme quoi j'ai bien enregistré dans le bon répertoire mais en réalité pas du tout. Mon fichier désiré s'enregistre dans le répertoire courant d'où je me trouve.
Je n'arrive pas à solutionner le problème. Quelqu'un aurait il une idée à me souffler?
Bien Merci d'avance
Abakisi
Sub msgbox_save()
'Msgbox Oui + Non
Select Case MsgBox("Enregistrer le fichier maintenant ?", vbYesNo + vbQuestion, "Sauvegarde du fichier")
Case vbYes
'procédure si on clique sur oui
Dim chemin As String
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire pour l'enregistrement du fichier", &H1&)
On Error GoTo Gesterr
Set oFolderItem = objFolder.Items.Item
chemin = oFolderItem.Path
Nom = ""
Select Case MsgBox("Voulez vous éditer le nom du fichier ?", vbYesNo + vbQuestion, "Sauvegarde du fichier")
Case vbYes
Nom = InputBox("Nom du fichier :")
End Select
If Right(Repertoire, 1) <> "\" Then
Repertoire = ActiveWorkbook.Path & "\"
End If
For Each feuille In ActiveWorkbook.Sheets
Repertoire = ActiveWorkbook.Path & "\"
feuille.Copy
With ActiveWorkbook
.Title = feuille.Name
.Subject = feuille.Name
.SaveAs Filename:="\" + feuille.Name + "_" + Nom + ".xlsx"
End With
Next
Gesterr::
Case vbNo
'procédure si on clique sur non
CreateObject("Wscript.shell").Popup "Le fichier n'a pas été sauvegardé Excel va se fermer automatiquement dans 2 secondes... Bonne journée", 3, "Fermeture d'Excel", vbExclamation
End Select
End Sub
Salut,
Premièrement, il n'y aura jamais de "\" en utilisant la fonction ActiveWorkbook.Path
Alors au lieu de :
If Right(Repertoire, 1) <> "\" Then
Repertoire = ActiveWorkbook.Path & "\"
End If
Met simplement :
Repertoire = ActiveWorkbook.Path & "\"
End If
Deuxièmement, à aucun moment tu n'utilise cette variable dans ton code.. Ce qui est étrange ^^.
Enfin, j'aimerai comprendre si tu souhaite :
- enregistrer ton fichier dans un répertoire fixe, donc peu importe le nom de la feuille se sera toujours le même;
OU
- enregistrer dans un répertoire changeant en fonction du nom du fichier ou autre.
Sinon pour définir la destination c'est dans cette ligne la :
.SaveAs Filename:="\" + feuille.Name + "_" + Nom + ".xlsx"
Tu pourrai définir ton répertoire de destination dans ta variable répertoire (qui n'est pas utilisée pour le moment) et modifier la ligne de code précédente pour donner ceci :
.SaveAs Filename:= repertoire & feuille.Name & "_" & Nom & ".xlsx"
Cdlt,
Bonjour VH_AE,
Merci beaucoup pour tes solutions, je commence déjà à voir où j'ai manqué de réflexion.
Pour question, effectivement je souhaite enregistrer dans un répertoire changeant en fonction du nom du fichier.
Merci beaucoup de ton aide,
Cdlt,
Abakisi
Bonjour,
J'ai modifié les lignes que tu m'as indiqué mais j'ai toujours le même problème : je choisi le répertoire mais l'enregistrement ce fait toujours dans le répertoire courant où se trouve mon fichier de base