Aide sur cette Macro de Sauvegarde.

[Mister Binaire]

Bonsoir le Forum,

J'ai cette macro de sauvegarde qui marche très bien son seul défaut c'est que le message :
If MsgBox("Fichier déjà existant , voulez vous continuer", vbYesNo) = vbNo Then Exit Sub n'apparaît jamais si l'utilisateur créer un fichier du même nom ?

Pouvez -vous m'aider ?

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

 

[camarchepas]

Re : Aide sur cette Macro de Sauvegarde.

Bonsoir ,

Z est un serveur ?

as tu essayé de mettre le chemin en local : c:\temp\" par exemple ?

si c'est cela , c'est le dir qui n'est pas adapté .

 

[Mister Binaire]

Re : Aide sur cette Macro de Sauvegarde.

Content de te revoir camarchepas !!!

Oui Z est un serveur, mais j'ai essayé en local à la maison et le résultat est le même !!!

 

[Mister Binaire]

Re : Aide sur cette Macro de Sauvegarde.

Bonjour le Forum,
Si quelqu'un a une idée, je suis preneur !!

 

[Bebere]

Re : Aide sur cette Macro de Sauvegarde.

bonjour Mister Binaire,Camarchepas
pas de réponse sur le fil précédent?
avec ce code le résultat est bon(pas d'erreur)
je pense que c'est fileformat qui pose problème
attention aux lignes à adapter(commentaires)

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

    'Prise en compte des éléments variables
    Chemin = "C:\Users\René\Downloads" '"Z:\PROCESS\LABO\Produits Finis\Etudes Process en Cours\"'à adapter
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"

    If Feuil1.Range("B2").Value <> "" Or Feuil1.Range("B3").Value <> "" Then
        Fichier = Feuil1.Range("B2").Value & "_" & Feuil1.Range("B3") & ".xls"  'à adapter, extension
    Else
        MsgBox " Attention, Merci de renseigner les cellules $B$2 et $B$3"
        Exit Sub
    End If
    
x = Dir(Chemin & Fichier)
Select Case Len(x)
Case 0
        ActiveWorkbook.SaveAs Filename:=Chemin & Fichier, FileFormat:=xlNormal 'Excel8
  Case Is > 0
        If MsgBox("Ce fichier existe déjà. Désirez-vous l'écraser ?" _
         , vbCritical + vbYesNo, "Attention") = vbYes Then
            'Si tu réponds oui, fichier écrasé
            Application.DisplayAlerts = False
            ThisWorkbook.SaveAs Filename:=Chemin & Fichier, FileFormat:=xlNormal 'Excel8
            Application.DisplayAlerts = True
        End If
    End Select
'    '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