XL 2021 Fermer et enregistrer avec "NOM DE FICHIER" = contenu de A3

Usine à gaz

XLDnaute Barbatruc

• 3 Juin 2023

• #2

Re-Bjr
La solution :

VB:

Sub Sauve()
    Dim Chemin$, Nom$
    NomFichier = Range("A3")     ' A modifier
    Chemin = ThisWorkbook.Path & "\"    ' A modifier si différent du dossier courant, doit se treminer par "\"
    ActiveWorkbook.SaveAs filename:=Chemin & NomFichier, Password:=MotDePasse
End Sub

A mettre dans un module et :

Code:

Private Sub Workbook_Open()
[A4].Value = ThisWorkbook.Name: [A4].Value = [a7]
If [A3] <> [A4] Then
    MsgBox ("Hola ! Ce fichier a été renommé : " & [A4].Value)
    Application.EnableEvents = True
    Sauve
    If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End If
End Sub
'Gérard
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If [A3] = [A4] Then
    Dim wb As Workbook
        For Each wb In Workbooks
        If wb.Name <> Me.Name Then wb.Close wb.Path <> "" 'sauvegarde uniquement si le fichier est enregistré
    Next
Me.Save
Application.Quit 'ferme Excel
End If
End Sub

Je joint le fichier test

 

Pièces jointes

• enregistrer sous.xlsm

  25.1 KB · Affichages: 1

Vote positif 0 Vote négatif

Solution

Usine à gaz

XLDnaute Barbatruc

• 3 Juin 2023

• #3

Re
Il ne me reste plus qu'a supprimer le mauvais fichier (celui qui avait été renommé)

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 3 Juin 2023

• #4

Bonjour Lionel,

Pas compris, à quoi sert Application.EnableEvents = True ?

A+

 

Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc

• 3 Juin 2023

• #5

Bjr Gérard,
"Pas compris, à quoi sert Application.EnableEvents = True ?"
LOL : à rien car j'avais oublié de l'enlever = Sorry

 

Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc

• 3 Juin 2023

• #6

Il ne me reste plus qu'a supprimer le mauvais fichier (celui qui avait été renommé)
Je cherche avec kill mais pour l'instant pas trouvé

 

Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc

• 3 Juin 2023

• #7

Bonjour à tous

Lionel

Usine à gaz à dit:

Je cherche avec kill mais pour l'instant pas trouvé

Cliquez pour agrandir...

Et comme ceci

VB:

Chemin = ThisWorkbook.Path & "\"
Kill ThisWorkbook.Path & "\" & Range("A4").Value & ".xlsm"
'Ou bien
Kill ThisWorkbook.Path & "\" & Range("A4").Value

@Phil69970

 

Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc

• 3 Juin 2023

• #8

Re-Bjr : supprimer le mauvais fichier (celui qui avait été renommé)

J'ai fait pas mal de recherches et tentatives sans vraiment y arriver Grrrr!!!!!
Voici le code que j'ai retenu mais qui ne fonctionne pas :

VB:

Sub suppr() 'Note le backslash (\) en fin du répertoire
Const Lw = "c:\"
Const path = "c:\"
Const file = Range("A4")
On Error GoTo error:
Kill file
MsgBox " Classeur " & file & "a été supprimé!"
Exit Sub
error:
MsgBox " Impossible de trouver un fichier avec le nom " & _
file & " être trouvé!"
End Sub

Il me donne cette erreur :

Si vous voulez bien m'aider, je joins le fichier...
Et le continue mes recherches

 

Pièces jointes

• enregistrer sous 2023 06 03.xlsm

  28 KB · Affichages: 5

Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc

• 3 Juin 2023

• #9

Lionel

Je te propose :

VB:

Sub Sup()
Chemin = "C:\"
Kill Chemin & Range("A4").Value & ".xlsm"
End Sub

@Phil69970

 

Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc

• 3 Juin 2023

• #10

Bjr Phil69970

Merci pour ce retour.
Il me fait une erreur :
= Erreur 53 fichier introuvable

 

Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc

• 3 Juin 2023

• #11

Re

Et ton chemin est il bon ?
Et est ce qu'il y a un fichier à supprimer !!!

@Phil69970

 

Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc

• 3 Juin 2023

• #12

Oui :
cellule A4 est le nom du fichier qui a été ouvert

 

Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc

• 3 Juin 2023

• #13

Re

Avec cette version tu n'auras plus de message si le fichier n'existe pas

VB:

Sub Sup()
On Error Resume Next
Chemin = "C:\"
Kill Chemin & Range("A4").Value & ".xlsm"
If Err = 53 Then
    MsgBox "Pas de fichier à supprimer"
    Exit Sub
End If
MsgBox "Fichier supprimé"
End Sub

C:\ est la lettre sur le disque dur ou est ton fichier
Et A4 ==> Nom du fichier à supprimer
Ton fichier sur le DD devait être ==> C:\Nom du fichier à supprimer

@Phil69970

 

Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc

• 3 Juin 2023

• #14

Phil69970 à dit:

Re

Avec cette version tu n'auras plus de message si le fichier n'existe pas

VB:

Sub Sup()
On Error Resume Next
Chemin = "C:\"
Kill Chemin & Range("A4").Value & ".xlsm"
If Err = 53 Then
    MsgBox "Pas de fichier à supprimer"
    Exit Sub
End If
MsgBox "Fichier supprimé"
End Sub

C:\ est la lettre sur le disque dur ou est ton fichier
Et A4 ==> Nom du fichier à supprimer
Ton fichier sur le DD devait être ==> C:\Nom du fichier à supprimer

@Phil69970

Cliquez pour agrandir...

Exact...
Mais j'ai ce message :

Pourtant mes 2 fichiers sont bien sur mon "bureau".
- enregistrer sous 2023 06 05 est le fichier qui a été renommé et ouvert,
- enregistrer sous 2023 06 03 est le fichier avec le nom d'origine qui a été sauvegardé

 

Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc

• 3 Juin 2023

• #15

Re

Lionel
Je doute que C:\enregistrer sous 2023 06 05 soit le chemin de ton fichier mais plutôt

C:\Users\TONUSER\Desktop

VB:

Sub Sup()
On Error Resume Next
Chemin = Environ("UserProfile") & "\Desktop\"
Kill Chemin & Range("A4").Value & ".xlsm"
If Err = 53 Then
    MsgBox "Pas de fichier à supprimer"
    Exit Sub
End If
MsgBox "Fichier supprimé"
End Sub

@Phil69970

 

Vote positif 0 Vote négatif