XL 2013 Modifier un code de sauvegarde

chaelie2015

XLDnaute Accro
Bonjour Forum
Le code ci-dessous réalise les actions suivantes :
  1. Il crée une copie du classeur actif avec un nom de fichier basé sur la valeur de la cellule M2 de la feuille "Récap".
  2. Il enregistre cette copie dans le répertoire actuel.
  3. Si un fichier existant porte le même nom, il demande à l'utilisateur s'il souhaite le remplacer.

VB:
Sub Enregistrer_Copie()
Dim nom$, fichier$
nom = "Evaluation CEO-" & Sheets("Récap").[M2] & ".xlsm"
fichier = ThisWorkbook.Path & "\" & nom
If Dir(fichier) <> "" Then If MsgBox("Le fichier EXCEL '" & nom & "' existe déjà. Voulez-vous le remplacer ?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
ThisWorkbook.SaveCopyAs fichier
MsgBox "Un nouveau fichier EXCEL nommé " & vbCrLf & vbCrLf & nom & vbCrLf & vbCrLf & " a été enregistré dans le répertoire " & vbCrLf & vbCrLf & ThisWorkbook.Path & "."
End Sub

mon souci est lié aux actions suivantes après la création de la copie :
  1. Afficher la copie du fichier créé.
  2. Fermer le fichier initial.
  3. Réinitialiser le fichier initial en appelant deux fonctions dans des modules "EffacerSoumissionnaires" et "EffacerMontantLots".
  4. Effacer trois cellules dans la feuille "BdD CEO" (D2, D4 et D5) et la cellule M2 de la feuille "Récap".

Merci
 

chaelie2015

XLDnaute Accro
Re
Je souhaite obtenir un code permettant de créer une copie du fichier initial, de lui attribuer un nouveau nom (nom = "Evaluation CEO-" & Sheets("Récap").[M2] & ".xlsm"), puis de l'enregistrer dans le même répertoire.(fichier = ThisWorkbook.Path & "\" & nom) Ensuite, je veux réinitialiser le fichier initial de telle manière que, lors de son ouverture ultérieure, il soit vide. Les plages de cellules à vider comprennent trois cellules dans la feuille "BdD CEO" (D2, D4 et D5), la cellule M2 de la feuille "Récap", ainsi que les plages "B7:B56" et "D7:BA56" dans la feuille "BdD CEO.
Merci
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Le code ci-dessous réalise les actions suivantes :
  1. Il crée une copie du classeur actif avec un nom de fichier basé sur la valeur de la cellule M2 de la feuille "Récap".
  2. Il enregistre cette copie dans le répertoire actuel.
  3. Si un fichier existant porte le même nom, il demande à l'utilisateur s'il souhaite le remplacer.
A mon avis, il vaudrait mieux mettre 3 avant 2.
Si 1 n'est pas la même chose que 2, alors c'est bon, sinon supprimer 1 (mais laisser 2).


mon souci est lié aux actions suivantes après la création de la copie :
  1. Afficher la copie du fichier créé.
  2. Fermer le fichier initial.
  3. Réinitialiser le fichier initial en appelant deux fonctions dans des modules "EffacerSoumissionnaires" et "EffacerMontantLots".
  4. Effacer trois cellules dans la feuille "BdD CEO" (D2, D4 et D5) et la cellule M2 de la feuille "Récap".
Là aussi l'ordre me semble ne pas être le bon. Je pense qu'il vaudrait mieux commencer par le 3, puis 1 et 2 (dans n'importe quel ordre).
Quant au 4, s'il travaille sur le fichier originel, l'exécuter juste après 1, sinon l'exécuter en dernier.



Sinon, as-tu pensé à utiliser un XLTM ?
 
Dernière édition:

chaelie2015

XLDnaute Accro
Bonsoir,
Voici le code après avoir effectué le ménage nécessaire 🤞 :
VB:
Sub Enregistrer_Copie()
    Dim nom$, fichier$
    nom = "Evaluation CEO-" & Sheets("Récap").Range("M2").Value & ".xlsm"
    fichier = ThisWorkbook.Path & "\" & nom
    If Dir(fichier) <> "" Then
        If MsgBox("Le fichier EXCEL '" & nom & "' existe déjà. Voulez-vous le remplacer ?", vbYesNo + vbQuestion) = vbNo Then
            Exit Sub
        Else
            Kill fichier ' Supprime le fichier existant s'il doit être remplacé.
        End If
    End If

    ' Sauvegarde une copie du classeur actif sous le nouveau nom de fichier.
    ThisWorkbook.SaveCopyAs fichier

   ' ' Ouvrir la copie du fichier.
   ' Workbooks.Open (fichier)

   ' ' Fermer le fichier initial.
   ' ThisWorkbook.Close

    ' Réinitialisation du fichier initial (appeler les fonctions).
    
    Sheets("BdD CEO").Range("B7:B56").ClearContents
    Sheets("BdD CEO").Range("D7:BA56").ClearContents

    ' Effacer les cellules spécifiques.
    Sheets("BdD CEO").Range("D2,D4,D5").ClearContents
    Sheets("Récap").Range("M1").ClearContents
  
    ' Ouvrir la copie du fichier.
    Workbooks.Open (fichier)
    
    ' Fermer le fichier initial.
    ThisWorkbook.Close
  
   ' UserForm2.TextBox1.Text = ""
    
    MsgBox "Un nouveau fichier EXCEL nommé " & vbCrLf & vbCrLf & nom & vbCrLf & vbCrLf & " a été enregistré dans le répertoire " & vbCrLf & vbCrLf & ThisWorkbook.Path & "."
End Sub
A+
 

Discussions similaires

Statistiques des forums

Discussions
313 281
Messages
2 096 787
Membres
106 748
dernier inscrit
Abdel93