Chemin vers dossier dans Z:\ pour sauvegarder Excel sous VBA
bonjour
J'essaye de trouver un moyen d'ouvrir une fenêtre afin de sauvegarder un fichier Excel, en ouvrant directement un dossier spécifique nommé "AGENCE" dans le Network"Z"
Si j'écris
sRep = WshShell.SpecialFolders("desktop"), ca fonctionne et ça ouvre la fenêre du Bureau.
Mais si j'écris
sRep = WshShell.SpecialFolders("z:/nom dossier/nom sous dossier"), ça ne fonctionne pas et ça n'ouvre que le dossier C:
Si quelqu'un y comprend un peu.....
Voici le code complet:
Sub save_excel() ' save a copy as excel
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim ret As Integer
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
' Creer une instance Windows Script pour retrouver le chemin du dossier AGENCE
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("DESKTOP")
Set WshShell = Nothing
' Definir le nom du fichier a enregistrer
sNomFic = Range("b1") & " " & Range("c1") & " " & "pnr" & "" & Range("j3") & "" & ".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
.Title = "Selectionnez un fichier destination et cliquez sur OK"
If .Show = -1 Then
ActiveWorkbook.SaveAs Filename:=.SelectedItems(1)
ActiveWorkbook.Saved = True
Else
Exit Sub
End If
End With
ThisWorkbook.Saved = True
Application.Quit
End Sub
Bonjour
un essai avec un change drive avant : mais normalement pas nécéssaire...
et en plus dans ton chemin il y a des "/" au lieu des "\" dans les séparations de dossiers/sous dossier...
' Definir le nom du fichier a enregistrer
sNomFic = "Toto.xls" 'Range("b1") & " " & Range("c1") & " " & "pnr" & "" & Range("j3") & "" & ".xls"
ChDrive ("Z:\") 'optionnel a faire des essais sans
sRep = "z:\nom dossier\nom sous dossier"
With Application.FileDialog(msoFileDialogSaveAs)
.FilterIndex = 4
.InitialFileName = sRep & "\" & sNomFic
.AllowMultiSelect = False
.Title = "Selectionnez un fichier destination et cliquez sur OK"
If .Show = -1 ThenFred
ca a l'air de marcher, merci!
mais ca sauvegarde le fichier en excel 1997-2003 alors que le fichier d'origine est Excel 2016.
Re bonjour
C est du fait que tu écris ceci
sNomFic = Range("b1") & " " & Range("c1") & " " & "pnr" & "" & Range("j3") & "" & ".xls"
Remplace par xlsx...
Fred
Ou xlsm si tu veux garder les macros...
Fred
j'ai corrigé avec l'extension xlsm
sNomFic = Range("b1") & " " & Range("c1") & " " & "pnr" & "" & Range("j3") & "" & ".xlsm"
mais quand la fenêtre Save As s'ouvre, elle me montre dans la ligne "Save as type" l'option Excel 97-2003 Workbook
à la place de l'option "Excel Macro-Enabled Workbook"
Essai avec ceci :
ActiveWorkbook.SaveAs Filename:=.SelectedItems(1), FileFormat:= xlOpenXMLWorkbookMacroEnabled, CreateBackup:=FalseFred
toujours pas...
Sub save_excel() ' save a copy as excel
Dim FileExtStr As String
Dim FileFormat As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim ret As Integer
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
' Creer une instance Windows Script pour retrouver le chemin du dossier AGENCE
Set WshShell = Nothing
' Definir le nom du fichier a enregistrer
sNomFic = Range("b1") & " " & Range("c1") & " " & "-" & " " & "pnr" & " " & Range("j3") & "" & ".xlsm"
ChDrive ("Z:\")
sRep = "z:\obrat tours\agence"
' 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
.Title = "Selectionnez le dossier de destination et cliquez sur OK"
If .Show = -1 Then
ActiveWorkbook.SaveAs Filename:=.SelectedItems(1), FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Saved = True
Else
Exit Sub
End If
End With
ThisWorkbook.Saved = True
Application.Quit
End Sub
autant pour moi... c'est au niveau de ton filterindex... il faut mettre 2
With Application.FileDialog(msoFileDialogSaveAs)
.FilterIndex = 2
.InitialFileName = sRep & "\" & sNomFic
.AllowMultiSelect = False
.Title = "Selectionnez le dossier de destination et cliquez sur OK"Fred