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

 

[Bebere]

Re : Améliorer une macro de sauvegarde

bonjour
Fichier = Range("B2").Value & " " & Range("B3")
question y a t'il l'extension du fichier dans la variable fichier
une fonction pour tester si le fichier existe

si FichierExiste=True msgbox ,si non sauver

Sub TestF()'un exemple avec msgbox qui donne la valeur de  FichierExiste

Dim Fichier As String
Fichier = ThisWorkbook.Path & "\" & "Classeur3.xls"
    MsgBox FichierExiste(Fichier)
End Sub

Function FichierExiste(NomFichier As String) As Boolean
    FichierExiste = Dir(NomFichier) <> "" And NomFichier <> ""
End Function

 

[Mister Binaire]

Re : Améliorer une macro de sauvegarde

Bonsoir Bebere, camarchepas,

Pour répondre à Bebere non il n'y a pas l'extension "xlms" dans la variable Fichier.
Fichier = Range("B2").Value & " " & Range("B3")

Comment mettre l'extension ?

Franchement, je ne vois pas comment faire pour éviter qu'un fichier du même nom écrase un autre

 

[Bebere]

Re : Améliorer une macro de sauvegarde

bonsoir


un exemple pour l'extension,tu peux aussi la mettre dans une cellule

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

essaye ce code pour test fichier,pour le test il me semble qu'il faut faire attention à l'extension

   fichier=chemin & fichier
 If Dir(fichier) = "" Then
        ActiveWorkbook.SaveAs Filename:=Chemin
    Else
        If MsgBox("Ce fichier existe déjà. Désirez-vous l'écraser ?" _
         , vbCritical + vbYesNo, "Attention") = vbYes Then
            'Si tu réponds oui, fichier écrasé
            ThisWorkbook.SaveCopyAs Filename:=xxx
        End If
    End If