pb à la sauvegarde d'une feuille par macro

[Solcarnus]

Bonjour

Je rencontre un problème avec l'une de mes macros que je n'arrive pas à contourner:
Je sauvegarde un classeur en .xls en utilisant une boite de diaogue pour demander à l'utilisateur de spécifier un nom et un chemin.
Je désire alors sauvegarder une de mes feuilles au format .csv en reprenant le nom et le chemin que l'utilisateur vient de me spécifier pour le fichier .xls
Pour cela j'utilise le code suivant:


'saving as *.xls
Application.Dialogs(xlDialogSaveAs).Show
'saving as *.csv
Sheets('transfert').Activate
ActiveWorkbook.Sheets('transfert').SaveAs FileFormat:=xlCSV


Le probleme est qu'en faisant cela excel renomme la feuille appelée transfert en lui donnant le nomde fichier que l'utilisateur a spécifié dans la boîte de dialogue.

Est-il possible d'empêcher cela?

Peut on sinon renommer la feuille en lui rendant son nom d'origine (j'ai essayé des trucs genre Sheets(Myfilename).name = 'transfert', mais cela n'a pas fonctionné)?

Merci d'avance à ceux qui prendront le temps de me répondre

 

[bebere]

bonjour Solcarnus

j'utilise le code suivant,si cela peut t'aider tant mieux
explication incluse

'Sauvegarde automatique d'une feuille d'un classeur
'(Joël MAU, mpfe)

'A l'ouverture de ton classeur la feuille de nom 'MaFeuille',
'à modifier à ta convenance avec la valeur de la constante
'NomFeuilleACopier, est copiée dans un nouveau classeur
'Ce classeur est sauvegardé dans un dossier de Sauvegarde
'(par défaut ici le dossier 'SAUVEGARDES\\', crée dans le dossier courant,
'modifiable avec la const...DossierSauvegarde )
'Pour garder toutes les versions et les reconnaitre le nom du fichier de
'sauvegarde est constitué par le nom d'origine de ton classeur plus le jour
'est l'heure-Minutes du dernier enregistrement de ton classeur.

'Pour lancer l'opération à l'ouverture du classeur :
'====dans le module ThisWorkbook :
'Private Sub Workbook_Open()
' SauvegardeFeuille
'End Sub
'==================

'Puis A Mettre dans un module standard de ton classeur dont
'une feuille est à copier à chaque ouverture:

Public Const NomFeuilleACopier As String = 'DocumentTransport'
Public Const DossierSauvegarde As String = 'DocTranspDepart\\'
Public Const sFormatDate As String = '''_''ddmmyy''_''hh''h''mm''mn'''
'attention notation americaine!!!

Sub SauvegardeFeuille()
Dim MaFeuille As Worksheet
Dim sPath As String, sFileSave As String

sPath = 'E:\\FichierPartage2003\\' 'ThisWorkbook.Path & '\\'
MsgBox ThisWorkbook.Name & ' ' & InfoDateModifFichier(ThisWorkbook.Name)
If FeuilleExiste(NomFeuilleACopier) Then
If Not FichierExiste(sPath & DossierSauvegarde) Then
' Dossier de sauvegarde inexistant
MkDir DossierSauvegarde ' sPath &
' crée le dossier de sauvegarde si inexistant
End If
sFileSave = sPath & DossierSauvegarde & NomFeuilleACopier & _
InfoDateModifFichier(ThisWorkbook.Name) & '.xls'
If Not FichierExiste(sFileSave) Then
' Le fichier n'existe pas déjà. Sinon pas besoin de resauvegarder
Worksheets(NomFeuilleACopier).Copy
ActiveWorkbook.SaveAs _
FileName:=sFileSave, FileFormat:=xlNormal, _
Password:='', WriteResPassword:='', _
ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Close SaveChanges:=False
' Pas la peine de reenregistrer cela vient d'être fait!
End If
End If

Sheets(NomFeuilleACopier).Select
Range('E4:H58').ClearContents
'Range('D6369').Select
' Selection.ClearContents
Range('D6369').ClearContents
Range('J63:J69').ClearContents
Range('N4:N16').ClearContents
End Sub


Function FeuilleExiste(sName As Variant) As Boolean

' Teste si la feuille de nom 'sName' existe au niveau classeur
' Retourne vrai si existe!


On Error Resume Next

FeuilleExiste = False
FeuilleExiste = Not ActiveWorkbook.Sheets(sName) Is Nothing
Err.Clear

End Function

Function FichierExiste(sFile As Variant) As Boolean

' Teste si le fichier ou dossier (avec ou sans le \\ à la fin)
' de nom 'sFile' existe. Retourne vrai si existe!

Dim sProv As String

On Error GoTo Errorhandler

sProv = Dir(sFile, vbDirectory)
' vbDirectory est utile quand dossier vide car retourne '.' alors

FichierExiste = (sProv <> '')

Exit Function

Errorhandler:
MsgBox prompt:='Erreur sur test fichier= ' & sFile
End

End Function


Function InfoDateModifFichier(ByVal sFileIn As String) As String

' Retourne la date/heure de modification d'un fichier ,
'et si pas existant la date/heure actuelle

If FichierExiste(sFileIn) Then
InfoDateModifFichier = Format(FileDateTime(sFileIn), sFormatDate)
Else
InfoDateModifFichier = Format(Now, sFormatDate)
'jour et heure actuelle
End If

End Function

à bientôt