Empecher que le classeur écrase un classeur deja existant

**Master_x_99** · 17/02/2016, 23h02

Bonjour

J'aimerais connaitre la façon de faire pour empêcher que le classeur écrase un classeur déjà existant. Et si possible de passer à la création du classeur suivant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
 
Sub generer_fichier()
'
' Generer_pages Macro.
'
Application.ScreenUpdating = False '=> A placer en début de macro.
Const Accents As String = "àâäåçéèêëîïôöùûüÈÉÊËÀÁÂÃÄÅÙÚÛÜ- ,"
Const Normaux As String = "aaaaceeeeiioouuuEEEEAAAAAAUUUU___"
    Dim c As Range, DerLigne As Integer, i As Byte
    Dim Ancien As String, Nouveau As String, Cible As String
    Dim VBComp As VBComponent
    Dim b As Integer
    Dim wbk As Workbook
    Dim w As Integer
    Dim Module As Object
 
    Sheets("Menu").Select
    DerLigne = Range("A65536").End(xlUp).Row
    For Each c In Range("A2:A" & DerLigne)
        For w = 1 To Len(Accents)
            c.Value = Replace(c.Value, Mid(Accents, w, 1), Mid(Normaux, w, 1))
        Next w
    Next c
 
    ' Déterminer combien d'agent sur la feuille Menu
    FinalAgent = Range("A65000").End(xlUp).Row
    ' Loop pour chaque agent
    For x = 2 To FinalAgent
        ThisAgent = Range("A" & x).Value
'Copie des feuilles
        ThisWorkbook.Sheets(Array("Janvier", "Admin_Janvier", "Fevrier", "Admin_Fevrier", "Mars", "Admin_Mars", "Avril", "Admin_Avril", "Mai", "Admin_Mai", "Juin", "Admin_Juin", "Juillet", "Admin_Juillet", "Aout", "Admin_Aout", "Septembre", "Admin_Septembre", "Octobre", "Admin_Octobre", "Novembre", "Admin_Novembre", "Decembre", "Admin_Decembre", "AGT", "SGT")).Copy        'adapte les noms des feuilles
 'Céation du nouveau fichier et enregistrement
        Set wbk = ActiveWorkbook
    Ancien = "new_agt"
    Nouveau = ThisAgent
       For Each VBComp In wbk.VBProject.VBComponents
        With VBComp.CodeModule
            If VBComp.CodeModule.Name <> "AfficheMacrosActiveworkbook" Then
                For b = 1 To VBComp.CodeModule.CountOfLines
                    Cible = VBComp.CodeModule.Lines(b, 1)
                    Cible = Replace(Cible, Ancien, Nouveau)
                    VBComp.CodeModule.ReplaceLine b, Cible
                Next b
            End If
        End With
    Next VBComp
Application.DisplayAlerts = True      'En placant True à la place de False, il me demande si je veux écraser l'ancien classeur. Est ce possible tout simplement de passer au suivant sans que je reçoive se message?
 
 
wbk.SaveAs ThisWorkbook.Path & "\" & ThisAgent & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
wbk.Close
Set wbk = Nothing
     Next x
Application.ScreenUpdating = True '=> A placer à la fin et il faut mettre "True"
MsgBox ("Opération terminée.")
End Sub

Merci de votre aide encore une fois

**kiki29** · 17/02/2016, 23h54

Salut, en t'inspirant de PDFCreator Générer des PDFs sans doublons via l'incrémentation d'un N° de fichier via la fonction RenommerFichierPDF(sChemin As String, sNomFichier As String) As String, en l'adaptant à ton contexte xls.

Sinon plus simplement via Manipulation des fichiers en VBA et FileExists en agissant en conséquence.

Ou encore mieux, en incorporant la date et heure de sauvegarde dans le nom du fichier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

wbk.SaveAs ThisWorkbook.Path & "\" & ThisAgent & "_" & Format(Date, "yyyymmdd hhmmss") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

**Master_x_99** · 18/02/2016, 03h57

J'ai placé ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Application.DisplayAlerts = True 'En placant True à la place de False, il me demande si je veux écraser l'ancien classeur. Est ce possible tout simplement de passer au suivant sans que je reçoive se message?
 
On Error Resume Next

Le tout fonctionne par contre j'aimerais que le message: Le fichier existe déjà voulez vous le remplacer. Ne s'affiche pas, en répondant à la question "NON".

Je sais si cela est possible

Merci

**kiki29** · 18/02/2016, 07h13

Salut, à incorporer dans ton salmigondis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Dim FSO As Object
Dim sNomFichier As String
 
    sNomFichier = ThisWorkbook.Path & "\" & ThisAgent & ".xlsm"
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    If FSO.FileExists(sNomFichier) Then
        '   .....
    Else
        wbk.SaveAs sNomFichier , FileFormat:=xlOpenXMLWorkbookMacroEnabled
    End If
    Set FSO = Nothing

**Philippe PONS** · 18/02/2016, 08h30

Salut,

le plus simple pour savoir si un fichier existe, c'est encore d'utiliser la fonction Dir(NomDeFichier).
Pas besoin de la scripting library.
Cordialement,

**Oliv-** · 18/02/2016, 10h29

Bonjour,
tu peux tester s'il exite et incrémenter ton nom de fichier avec un chiffre par exemple pour créer un nouoveau nom libre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
    PathNomExport = ThisWorkbook.Path & "\" & ThisAgent & ".xlsm"
    n = 1
    MemPath = PathNomExport
    MemNamePath = StrReverse(Split(StrReverse(PathNomExport), "\", 2, vbBinaryCompare)(0))
    MemDirPath = StrReverse(Split(StrReverse(PathNomExport), "\", 2, vbBinaryCompare)(1))
    While Dir(PathNomExport) <> ""
        PathNomExport = MemDirPath & "\" & "(" & n & ")" & MemNamePath
        n = n + 1
    Wend
    MsgBox PathNomExport
 
wbk.SaveAs PathNomExport, FileFormat:=xlOpenXMLWorkbookMacroEnabled

**Master_x_99** · 18/02/2016, 15h22

Bonjour Merci de vos réponses aussi rapide.

Les deux codes fonctionnent à merveille. J'aime bien celui de Kiki, car il ne crée pas de nouveau classeur si le nom du classeur existe déjà.

Par contre, seul souci c'est qu'il se crée tout de même un classeur du nom de classeur(x).xlsm. Il me demande si je veux l'enregistrer.

Serais t-il possible de faire fermer automatiquement ce classeur (classeur(x).xlsm) sans l'enregistrer?

Merci

**Oliv-** · 18/02/2016, 16h09

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Wkb.Close SaveChanges:=False

**kiki29** · 18/02/2016, 17h33

Re, qqch de ce genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim FSO As Object
Dim sNomFichier As String
Dim Wkb As Workbook
 
    sNomFichier = ThisWorkbook.Path & "\" & ThisAgent & ".xlsm"
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    If FSO.FileExists(sNomFichier) Then
        Wkb.Close SaveChanges:=False
    Else
        wbk.SaveAs sNomFichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    End If
    Set FSO = Nothing

Empecher que le classeur écrase un classeur deja existant

Macros et VBA Excel

Discussions similaires

Partager

Partager