Discussion :

[LANGAZOU]

Bonjour,

j'ai créé une macro Excel qui sélectionne des champs EXCEL et les faire coller sous word (format image), ce fichier est enregistré à la fin dans un dossier. le problème est lorsque je clique 2 fois sur ma macro pour le même nom du client l'ancien fichier se supprime et sera remplacer par le nouveau (parce qu'il est enregistré pour le même nom de relation). y'at-il un moyen qui me permet de garder l'ancien fichier par exemple s'il trouve dans le dossier d'enregistrement le même nom de fichier ("TOTO") il ajoute ("TOTO1") et l'enregistre par la suite.

Merci pour votre réponse.

[gnain]

Bonjour,
avant d'enregistrer, il faut vérifier si existe.

ex:

Code :

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

1
2
3
4
5
6
7
8
9
 Dim Fichier_exist As Object
 Dim Chemin_Fichier As String
 Chemin_Fichier = "C:\chemin du fichier\non du fichier.doc"
     Set Fichier_exist = CreateObject("Scripting.FileSystemObject")
     If Fichier_exist.FileExists(Chemin_Fichier) = True Then
        MsgBox "exist"
    Else
        MsgBox "non"
    End If

si il exist on change le nom et on revérifie ...
si il n'existe pas on enregistre.

[kiki29]

Salut, à adapter à ton contexte

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
Option Explicit
 
Sub Tst()
Dim sNom As String
Dim sDossier As String, sOut As String
 
    '.....
 
    sDossier = "C:\A\B\C"
    sOut = "Essai.doc"
    sNom = RenommerFichier(sDossier, sOut)
 
    '.....
End Sub
 
Private Function RenommerFichier(sChemin As String, sNomFichier As String) As String
Dim sNouveauNom As String
Dim sPre As String
Dim sExt As String
Dim iExt As Long
Dim i As Long, Pos As Long
Dim FSO As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.fileExists(sChemin & "\" & sNomFichier) = True Then
        sNouveauNom = sNomFichier
        Pos = InStrRev(sNomFichier, ".")
        iExt = Len(sNomFichier) - Pos + 1
        If Pos > 0 Then
            sExt = Right$(sNomFichier, iExt)
            sPre = Left$(sNomFichier, Len(sNomFichier) - iExt)
        Else
            sExt = ""
            sPre = sNomFichier
        End If
 
        i = 0
        While FSO.fileExists(sChemin & "\" & sNouveauNom) = True
            i = i + 1
            '   sPre.sExt
            '   càd par exemple zaza.pdf zaza(001).pdf zaza(002).pdf etc
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & sExt
        Wend
        sNomFichier = sNouveauNom
    End If
    Set FSO = Nothing
    RenommerFichier = sChemin & "\" & sNomFichier
End Function

Un exemple ici, dans un contexte particulier.

[LANGAZOU]

Bonjour ,

C'est exactement ce que je cherchais ;-)

Merci pour votre réponse.