Save As & code VBA

Mi_

XLDnaute Occasionnel
Bonjour le forum,

J'aurais besoin d'aide sur le code VBA pour une opération 'd'enregistrer sous' directe, sans passer par la fenêtre de dialogue.

Pour le moment j'utilise:

ChDir 'C:\\Toto'
Application.Dialogs(xlDialogSaveAs).Show CStr(ThisWorkbook.ActiveSheet.Range('B3').Value) & Format(Date, 'dd-mm-yyyy')


Ce qui donne automatiquement le chemin dans C:\\Toto déjà existent, le nom du fichier est repris de la cellule B3, et la date du jour s'y ajoute aussi à son nom.

Bon.

Je cherche:
- ne plus passer par l'écran Save As mais enregistrer directement le fichier (avec seulement une confirmation 'Ok, c'est enregistré' à la fin;
- si le dossier cible 'C:\\Toto' n'existe pas, qu'il soit créé automatiquement, puis le fichier enregistré dedans; si C:\\Toto existe déjà, enregistrer le fichier dedans;
- si un fichier du même nom existe déjà, surécrire l'ancien fichier automatiquement, sans demander de confirmation.

Merci d'avance pour tout conseil.

Cordialement,
Mi
 

myDearFriend!

XLDnaute Barbatruc
Bonsoir Mi_,

Tu peux essayer la procédure suivante :
Sub Sauvegarde()
Dim Dossier As String, Fichier As String
      'Mémorise et vérifie les noms de dossier et fichier
      With ActiveSheet
            Dossier = CStr(.Range('A1').Value)
            Fichier = CStr(.Range('B3').Value) & Format(Date, 'dd-mm-yyyy')
      End With
      If Trim(Dossier) = '' Then Exit Sub
      If Trim(Fichier) = '' Then Exit Sub
      'Sauvegarde
      On Error GoTo CreerDossier
      Application.DisplayAlerts = False
      ThisWorkbook.SaveAs 'C:\' & Dossier & '\' & Fichier & '.xls'
      Application.DisplayAlerts = True
      MsgBox 'Ok, c'est enregistré.'
Exit Sub
CreerDossier:
      If Err.Number = 1004 Then
            'Création du dossier
            MkDir 'C:\' & Dossier
            Resume
      Else
            MsgBox 'Erreur : ' & Err.Number & vbLf & Err.Description
      End If
End Sub
Cordialement,
 

Mi_

XLDnaute Occasionnel
Bonjour myDearFriend!

Apparement c'est OK, c'est exactement ce qu'il me fallais.

Par contre, il y a la ligne Exit Sub qui me gêne. En éffet, j'intègre ton code dans un macro plus long, et cet Exit Sub annule toutes les lignes qui suivent après ton code.

Existe-t-il un moyen de remplacer cet Exit Sub par autre code pour contourner le problème ?

Si cela peut servir, juste après ton code, j'ai:

ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

En tout cas, merci de ton temps et de ton aide très précieuse.

Mi
 

myDearFriend!

XLDnaute Barbatruc
Bonsoir Mi_, le Forum.

Dans ce cas Mi_, tu peux insérer ton code juste entre 'MsgBox 'Ok, c'est enregistré.'' et le 'Exit Sub' en question. Ce 'Exit Sub' indique la fin de la procédure. Tout ce qu'il y a après, sert à gérer l'erreur en cas de dossier non créé et peut-être considéré comme une autre procédure à part entière.

Cela dit, sauf erreur de ma part, comme ton ActiveWorkbook est égal au ThisWorkbook, je comprends le pourquoi du 'ActiveWorkbook.Close' (pour fermer le classeur en question), mais j'ai un peu plus de mal à comprendre le 'ActiveWorkbook.Save' puisque le but de la macro était déjà de le sauvegarder (selon le nom et le chemin indiqué plus haut)...

Par ailleurs, si j'ai bien interprété ton intention, pour plus de clarté et pour lever toute ambiguïté, je te conseillerais d'utiliser 'ThisWorkbook.Close' en lieu et place de 'ActiveWorkbook.Close'.

Cordialement,
 

Mi_

XLDnaute Occasionnel
Bonsoir myDearFriend!

J'ai surmonté le Exit Sub en plaçant juste devant lui:

ActiveWorkbook.Save
ActiveWorkbook.Close


et une copie aussi après End If donc à la fin, après le passage CreerDossier:.

Bon. Maintenant pourquoi ActiveWorkbook.Save/Close ? Simplement parce qu'ils ferment une série de commandes débutées par ActiveSheet.Copy, et entre le 'Save As' et le final, il y a encore quelques commandes. En bref, c'est dû aux particularitées de mon macro entier.

Merci encore une fois de ton aide, maintenant j'ai un macro qui sauvegarde une feuille d'un classeur avec des conditions complèxes, qui marche nickel.

Mi
 

Discussions similaires

Statistiques des forums

Discussions
314 628
Messages
2 111 333
Membres
111 104
dernier inscrit
JEMADA