Améliorer une macro de sauvegarde

[Mister Binaire]

Bonjour le Forum,

Cette macro de sauvegarde (voir ci-dessous) fonctionne très bien, cependant quand l'utilisateur re clic sur le bouton une seconde fois pour enregistrer son travail le message "le nom du fichier existe déja voulez l'écrasez" apparaît est il possible de modifier la macro pour éviter ce message un peu comme par l'interface excel une fois que l'enregistrer sous a été effectué.

Merci de votre aide ...

Sub Sauvegarde()
On Error Resume Next ' s'il y a une erreur sur la prochaine ligne elle sera ignorée
With ActiveWorkbook
.SaveAs "Z:\PROCESS\LABO\Produits Finis\Etudes Process en Cours\" & Range("B2").Value & " " & Range("B3"), FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End With
If Err Then ' si 'il y a eu une erreur
On Error GoTo 0 'on annule l'erreur
MsgBox " Attention, Merci de renseigner les cellules $B$2 et $B$3" 'on prévient l'utilisateur
End If
End Sub

 

[CHALET53]

Re : Améliorer une macro de sauvegarde

Bonjour,

Peut-être en rajoutant en début de programme :

Application.displayAlerts=false

et la repasser à vrai à la fin

a+

 

[camarchepas]

Re : Améliorer une macro de sauvegarde

Bonjour Chalet, Mister Binaire ,

Bon , une solution un peu moins , je rendre dans le mur , et je constate les dégats
bien sûr , la désactivation du message d'erreur est la même que celle de M. Chalet

Sub Sauvegarde()
Dim Chemin As String, Fichier As String

'Prise en compte des éléments variables
 Chemin = "Z:\PROCESS\LABO\Produits Finis\Etudes Process en Cours\"
 Fichier = Range("B2").Value & " " & Range("B3")

'Alertes utilisateur
'Type1 : Dossier non disponible
If Right(Chemin, 1) <> "\" Then MsgBox "Chemin non conforme , manque le \ à la fin ": Exit Sub
If Dir(Chemin & "\", vbDirectory) = "" Then MsgBox " Attention, Dossier de stockage non disponible": Exit Sub

'Type2 : Nom du fichier non renseigné
If Fichier = " " Or Fichier = "" Then MsgBox " Attention, Merci de renseigner les cellules $B$2 et $B$3": Exit Sub

Application.DisplayAlerts = False ' Désactive les alertes en validant l'action par défaut
 On Error Resume Next ' s'il y a une erreur sur la prochaine ligne , l'on exécute la ligne suivante
  ActiveWorkbook.SaveAs Chemin & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
  If Err Then ' si 'il y a eu une erreur
    'échec de lecture ou d'écriture à partir d'un fichier.
     If Err.Number = 1004 Then MsgBox "échec de lecture ou d'écriture à partir d'un fichier."
   ' Liste et message appropriés en fonction des erreur rencontrées
   'Exemple
   If Err.Number = 75 Then MsgBox "Erreur d'accès chemin/fichier (erreur 75)"
  End If
On Error GoTo 0 'Rend la main au gestionnaire d'erreur
Application.DisplayAlerts = True ' Réactivation des alertes

End Sub

 

[Mister Binaire]

Re : Améliorer une macro de sauvegarde

Merci camarchepas c'est vraiment du travail de Pro tout marche vraiment comme je le souhaitais.
Merci également a chalet53

Merci encore de votre aide !!

 

[Mister Binaire]

Re : Améliorer une macro de sauvegarde

Je reviens vers toi camarchepas juste pour un détail.

J'ai remarqué que si uniquement le champs b2 était complété sans le champs b3 la sauvegarde s'effectuait quand même.

Est-il possible de modifier la macro comme quoi les deux champs doivent être complétés pour la sauvegarde si uniquement un champs de remplit b1 ou b2 alors impossible de sauvegarder avec message comme quoi les deux champs doivent être remplis .

Merci une nouvelle fois de ton aide...

 

[camarchepas]

Re : Améliorer une macro de sauvegarde

Voici

en zoom la modif :

'Type2 : Nom du fichier non renseigné
If Range("B2").Value= "" or Range("B3").value =''" Or Fichier = "" Then MsgBox " Attention, Merci de renseigner les cellules $B$2 et $B$3": Exit Sub


je te remets l'ensemble du code modifié ...

Sub Sauvegarde()
Dim Chemin As String, Fichier As String

'Prise en compte des éléments variables
 Chemin = "Z:\PROCESS\LABO\Produits Finis\Etudes Process en Cours\"
 Fichier = Range("B2").Value & " " & Range("B3")

'Alertes utilisateur
'Type1 : Dossier non disponible
If Right(Chemin, 1) <> "\" Then MsgBox "Chemin non conforme , manque le \ à la fin ": Exit Sub
If Dir(Chemin & "\", vbDirectory) = "" Then MsgBox " Attention, Dossier de stockage non disponible": Exit Sub

'Type2 : Nom du fichier non renseigné
If Range("B2").Value= "" or Range("B3").value =''"  Or Fichier = "" Then MsgBox " Attention, Merci de renseigner les cellules $B$2 et $B$3": Exit Sub

Application.DisplayAlerts = False ' Désactive les alertes en validant l'action par défaut
 On Error Resume Next ' s'il y a une erreur sur la prochaine ligne , l'on exécute la ligne suivante
  ActiveWorkbook.SaveAs Chemin & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
  If Err Then ' si 'il y a eu une erreur
    'échec de lecture ou d'écriture à partir d'un fichier.
     If Err.Number = 1004 Then MsgBox "échec de lecture ou d'écriture à partir d'un fichier."
   ' Liste et message appropriés en fonction des erreur rencontrées
   'Exemple
   If Err.Number = 75 Then MsgBox "Erreur d'accès chemin/fichier (erreur 75)"
  End If
On Error GoTo 0 'Rend la main au gestionnaire d'erreur
Application.DisplayAlerts = True ' Réactivation des alertes

End Sub

 

[Mister Binaire]

Re : Améliorer une macro de sauvegarde

Merci pour le travail accompli camarchepas tout fonctionne à merveille !!

 

[Bebere]

Re : Améliorer une macro de sauvegarde

bonjour Mister binaire,Chalet,camarchepas
utiliser la propriété saved du classeur pour empêcher un 2ème enregistrement
If ActiveWorkbook.Saved = True then exit sub

 

[Mister Binaire]

Re : Améliorer une macro de sauvegarde

Merci de ton observation Bebere c'est vrai il fallait y penser !!

 

[Mister Binaire]

Re : Améliorer une macro de sauvegarde

Question ;

Je la colle à quel endroit de la macro cette ligne de code pour qu'elle fonctionne ??

Car là sur un second fichier du même non l'ancien est écrasé sans avertissement ??

Merci de votre aide !!

 

[camarchepas]

Re : Améliorer une macro de sauvegarde

Et oui , et ceci était ta demande .

Je pense non :

est il possible de modifier la macro pour éviter ce message un peu comme par l'interface excel une fois que l'enregistrer sous a été effectué.

*
voici l'intégration de la fonction :

Sub Sauvegarde()
Dim Chemin As String, Fichier As String
If ActiveWorkbook.Saved = True then exit sub 
'Prise en compte des éléments variables
 Chemin = "Z:\PROCESS\LABO\Produits Finis\Etudes Process en Cours\"
 Fichier = Range("B2").Value & " " & Range("B3")

'Alertes utilisateur
'Type1 : Dossier non disponible
If Right(Chemin, 1) <> "\" Then MsgBox "Chemin non conforme , manque le \ à la fin ": Exit Sub
If Dir(Chemin & "\", vbDirectory) = "" Then MsgBox " Attention, Dossier de stockage non disponible": Exit Sub

'Type2 : Nom du fichier non renseigné
If Range("B2").Value= "" or Range("B3").value =''"  Or Fichier = "" Then MsgBox " Attention, Merci de renseigner les cellules $B$2 et $B$3": Exit Sub

Application.DisplayAlerts = False ' Désactive les alertes en validant l'action par défaut
 On Error Resume Next ' s'il y a une erreur sur la prochaine ligne , l'on exécute la ligne suivante
  ActiveWorkbook.SaveAs Chemin & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
  If Err Then ' si 'il y a eu une erreur
    'échec de lecture ou d'écriture à partir d'un fichier.
     If Err.Number = 1004 Then MsgBox "échec de lecture ou d'écriture à partir d'un fichier."
   ' Liste et message appropriés en fonction des erreur rencontrées
   'Exemple
   If Err.Number = 75 Then MsgBox "Erreur d'accès chemin/fichier (erreur 75)"
  End If
On Error GoTo 0 'Rend la main au gestionnaire d'erreur
Application.DisplayAlerts = True ' Réactivation des alertes

End Sub

 

[Mister Binaire]

Re : Améliorer une macro de sauvegarde

Merci de ton aide une fois de plus camarchepas.

Mais l'intégration de cette fonction ne change rien sur deux enregistrements d'un fichier du même nom le second enregistrement écrase le premier fichier sans prévenir l'utilisateur ?

Merci de ton aide !!

 

[camarchepas]

Re : Améliorer une macro de sauvegarde

Comme cela , mais dans ce cas pourquoi avoir supprimer le message système ?

Sub Sauvegarde()
Dim Chemin As String, Fichier As String
If ActiveWorkbook.Saved = True then exit sub
'Prise en compte des éléments variables
 Chemin = "Z:\PROCESS\LABO\Produits Finis\Etudes Process en Cours\"
 Fichier = Range("B2").Value & " " & Range("B3")

'Alertes utilisateur
'Type1 : Dossier non disponible
If Right(Chemin, 1) <> "\" Then MsgBox "Chemin non conforme , manque le \ à la fin ": Exit Sub
If Dir(Chemin & "\", vbDirectory) = "" Then MsgBox " Attention, Dossier de stockage non disponible": Exit Sub

'Type2 : Nom du fichier non renseigné
If Range("B2").Value= "" or Range("B3").value =''"  Or Fichier = "" Then MsgBox " Attention, Merci de renseigner les cellules $B$2 et $B$3": Exit Sub
if dir(Chemin & Fichier)<>"" then  
   If MsgBox("Fichier déjà existant , voulez vous continuer", vbYesNo) = vbNo Then Exit Sub
end if
Application.DisplayAlerts = False ' Désactive les alertes en validant l'action par défaut
 On Error Resume Next ' s'il y a une erreur sur la prochaine ligne , l'on exécute la ligne suivante
  ActiveWorkbook.SaveAs Chemin & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
  If Err Then ' si 'il y a eu une erreur
    'échec de lecture ou d'écriture à partir d'un fichier.
     If Err.Number = 1004 Then MsgBox "échec de lecture ou d'écriture à partir d'un fichier."
   ' Liste et message appropriés en fonction des erreur rencontrées
   'Exemple
   If Err.Number = 75 Then MsgBox "Erreur d'accès chemin/fichier (erreur 75)"
  End If
On Error GoTo 0 'Rend la main au gestionnaire d'erreur
Application.DisplayAlerts = True ' Réactivation des alertes

End Sub

 

[Bebere]

Re : Améliorer une macro de sauvegarde

Bonsoir

'en lisant l'aide
'Cette propriété a la valeur True si le classeur spécifié n'a pas été modifié depuis son dernier enregistrement
'If ActiveWorkbook.Saved = True Then Exit Sub
'Cet exemple montre comment afficher un message si le classeur actif contient des modifications non enregistrées.
'If Not ActiveWorkbook.Saved Then
' MsgBox "This workbook contains unsaved changes."
'End If


pour éviter un message inutile
Chemin = "Z:\PROCESS\LABO\Produits Finis\Etudes Process en Cours\"
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"

If Range("B2").Value = "" Or Range("B3").Value = "" Then
Fichier = Range("B2").Value & " " & Range("B3")
Else
MsgBox " Attention, Merci de renseigner les cellules $B$2 et $B$3"
Exit Sub
End If

 

[Mister Binaire]

Re : Améliorer une macro de sauvegarde

Bonjour camarchepas, Bebere,

Une nouvelle fois merci à vous deux de votre aide.

Cependant malgré la modification de la macro par camarchepas cela ne fonctionne toujours pas.

Si j'enregistre un nom de fichier identique au premier, je n'arrive pas à avoir le message d'alerte :
If MsgBox("Fichier déjà existant , voulez vous continuer", vbYesNo).
le fichier est tout simplement écrasé et remplacé sans que l'utilisateur est été prévenu ?

Merci de votre aide à tous les deux !!