saveas sur fichier existant

[Shock]

Bonjour @ tous,
j'ai un (petit) souci avec la méthode SaveAs :
J'ai un classeur assez gros, pour lequel je propose à l'utilisateur d'enregistrer le projet sur lequel il travaille. Pour cela je passe par la copie des feuilles qui m'intéressent (4 sur 14 dans le classeur d'origine) dans un nouveau classeur, le nouveau classeur est alors enregistré via Activeworkbook.SaveAs dans le même répertoire avec un nom choisi automatiquement ('Texte cellule a_Texte cellule b'). Tout se passe bien, sauf si le fichier existe déjà. Dans ce cas, je peux remplacer le fichier en cliquant sur Oui dans la fenêtre qui s'ouvre, mais si je clique sur 'Non' (= 'ne pas remplacer le fichier') j'ai un bug!
J'aurai voulu forcer l'utilisateur à changer le nom directement dans la cellule s'il veut conserver 2 copies du projet...
...Est-ce que je suis compréhensible??!!! :\\


Merci d'avance à ceux qui pourront m'aider!

 

[Papaye]

Bonjour Shock,

As tu essayé avant l'enregistrement de tester si le classeur existe déjà ? :

With Application.FileSearch
.NewSearch
.LookIn = NomdeMonRepertoire
.SearchSubFolders = False
.Filename = NomdeMonFichier
.MatchAllWordForms = True
.FileType = msoFileTypeAllFiles
If (.Execute() > 0) Then
msgbox 'Fichier déjà existant'
else
Save ... machin truc
End With


Papaye

 

[Shock]

bjr papaye,
j'y avais pensé...mais à vrai dire je voulais l'éviter (la macro est déjà lourde), et je pensais que dans les arguments de la méthode SaveAs on pouvait faire faire un choix, ou modifier le nom...ou peut-etre meme récupérer la valeur du 'Non' de la fenêtre qui s'ouvre...parce que finalement, le test est déjà effectué par SaveAs...

j'suis ch*** hein?!!!

:whistle:

 

[Blunet]

Salut Shock et Papaye,

Tu peux seulement arrêter l'enregistrement du fichier et permettre à l'utilisateur de saisir un nouveau nom. J'évite simplement le bug avec On Error resume Next

Sub svgde()
On Error Resume Next
ActiveWorkbook.SaveAs Range('A1').Value
Sheets('Feuil1').Activate
End Sub

A+

 

[Papaye]

Mais non, mais non ...

En fait, dans SaveAs tu as une option ConflictResolution.

Je ne l'ai jamais essayé ... Et toi ?

Papaye

 

[Shock]

bijour Blunet,

->Papaye : ben justement, j'ai vu cette option...j'ai essayé de mettre 'xlUserResolution' pour ouvrir (enfin je crois) la fenêtre 'Enregistrer sous...' mais je sais pas trop comment ca marche... Il attend un '=' en fin de ligne...??
Je vous met mon bout de code :

Install = Sheets('Accueil_Aide').Range('D21').Text
Client = Sheets('Accueil_Aide').Range('D22').Text
ActiveWorkbook.Sheets(Array(1, 2, 3, 4, 5)).Copy
With ActiveWorkbook
.Saveas(ThisWorkbook.Path & '\\Projets\\Install & '_' & Client & '.xls', , , , , , , xlUserResolution)
.Close
End With

Ca marchait bien sans mettre le xlUserResolution...comprend plus!!


...euh, j'en oubliais Blunet :
je vais essayer, c'est peut bien la solution la plus simple...@ voir

Message édité par: Shock, à: 15/06/2006 14:38

 

[Papaye]

Je suis pas arrivée à faire mieux que :

Sub toto()
On Error GoTo Fin
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, ConflictResolution:=xlUserResolution
Exit Sub

Fin:
MsgBox 'Changer le nom du fichier'

End Sub

Si tu cliques sur annuler ou non, tu génère l'affiches du msg box !

Papaye

 

[Papaye]

Je suis pas arrivée à faire mieux que :

Sub toto()
On Error GoTo Fin
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, ConflictResolution:=xlUserResolution
Exit Sub

Fin:
MsgBox 'Changer le nom du fichier'

End Sub

Si tu cliques sur annuler ou non, tu génère l'affiches du msg box !

Papaye

 

[Bricofire]

Bonjour tout le monde,

Shock, tu peux aller voir ici pour éviter les messages :

Lien supprimé

c'est peut-être déjà fait, si tu veux effectivement cumuler des copies indexées, un moyen possible serait dans ton code de :
1- Tester l'existence du classeur en adaptant ceci :
if Dir('c:toto.xls')='' then msgbox 'le fichier est introuvable!' (truc de laurent Longre).
2- si le fichier est introuvable, tu valides ta procédure de sauv. S'il existe, tu lui ajoutes un chiffre 1 (suffit d'une varaible compteur), tu teste, si encore existant, tu fait évoluer at variable compteur etc...

2 bis- sinon pour ne pas te casser la tête, si c'est une nouvelle copie ben sa terminaison est une variable avec des bouts de la date et de l'heure (facile à récupérer)genre 1506061546 (ce jour à 15h456), tu ne risuqe pas d'avoir de doubles...Par contre prévoie un nettoyage périodique

Bonne journée,

Brico

 

[Shock]

Je crois que je vais me faire un mélange des 2!!
merci à vous!

Je m'explique :
je fait un On error GoTo truc

....

truc:
activeworkbook.saveas ('nomfichier'& filedatetime & '.xls')

end sub

ou un truc dans le genre...je vais tester tout ça, je vous tiens au jus!

 

[Shock]

Bricofire écrit:

2 bis- sinon pour ne pas te casser la tête, si c'est une nouvelle copie ben sa terminaison est une variable avec des bouts de la date et de l'heure (facile à récupérer)genre 1506061546 (ce jour à 15h456), tu ne risuqe pas d'avoir de doubles...Par contre prévoie un nettoyage périodique

lol j'avais pas vu!!
:silly:

 

[Papaye]

Bonjour à tous,

Grande chaleur déjà sur La Réunion.

On survit vous inquiètez pas.

Juste pour signaler ce fil qui parlait de l'enregistrement de fichiers avec date et heure :

Lien supprimé

Papaye

 

[Shock]

bjr à tous,

j'ai trouvé ma solution, merci beaucoup!

Pour info :

Install = Sheets('Accueil_Aide').Range('D21').Text
Client = Sheets('Accueil_Aide').Range('D22').Text
ActiveWorkbook.Sheets(Array(1, 2, 3, 4, 5)).Copy

If Dir(ThisWorkbook.Path & '\\Projets\\' & Install & '_' & Client & '.xls') = '' Then
sauve:
ActiveWorkbook.Saveas (ThisWorkbook.Path & '\\Projets\\' & Install & '_' & Client & '.xls')
Nomfichier = ActiveWorkbook.Name
ActiveWorkbook.Close
Application.ScreenUpdating = True
Else
fichier = MsgBox('Le fichier existe déjà, voulez-vous le remplacer?', vbOKCancel, 'Fichier existant')
    If fichier = vbOK Then
    GoTo sauve
    Else
    MsgBox 'Veuillez changer la référence projet saisie sur la page d'accueil afin de créer une variante du projet'
    ActiveWorkbook.Close False
    Exit Sub
    End If
Application.ScreenUpdating = True

End If

MsgBox 'Votre projet est enregistré sous le nom :' & Chr(10) & Chr(10) & _
Nomfichier, vbInformation, 'Projet enregistré!'

Voilà, en fait je fais le test avant la méthode SaveAs, comme ça, j'évite également l'erreur, et je 'force' l'utilisateur à changer le nom de son projet.

Merci encore,
@+ sur le forum!