Bonjour,

J'ai un problème avec l'enregistrement des fichiers.
En faite j'enregistre mes fichier au format <ID "demande d'achat" émetteur fournisseur date du jour>
J'aimerais que l'ID s’incrémente a chaque nouvel enregistrement pour que les noms ce suivent.
Pour ce faire je test si le fichier existe déjà dans le répertoire ou se situe les fichiers.
Le problème c'est que cela marche que si j’enregistre plusieurs fichier le même jours car si je le fait a une autre date le fichier prend l ID 0 comme la date a change et qu'il pense que le fichier n'existe pas.
Peut t-on tester juste le début du nom d'un fichier ?
Y-a-t-il une autre solution ?

Merci d'avance !

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub DEMANDE_DE_VALIDATION_CHEF_DE_SERVICE()
 
 
'declaration des variables'
Dim ID As Integer
Dim Fichier_existe As String
Dim NomDossier As String
Dim NomFichier As String
Dim NomFournisseur As String
Dim FichierAtester As String
Dim Emetteur As String
Dim Adresse_emetteur As String
Dim Adresse_recepteur As String
Dim Date_DA As String
 
 
ActiveSheet.Unprotect Password:="CIA"
 
 
'Recuperation de l'emetteur'
Adresse_emetteur = Application.UserName
Range("Z24").Value = Range("D3").Value
Date_DA = Range("Z24").Value
 
 
' Recuperation des infos du fichier parametre '
 
' MAINTENANCE'
If Range("D4").Value = "MAINT" Then
 NomDossier = Range("AE11")
 Adresse_recepteur = Range("Z11")
 
'GP'
ElseIf Range("D4").Value = "GP" Then
 NomDossier = Range("AE12")
 Adresse_recepteur = Range("Z12")
 
 'QUALITE'
ElseIf Range("D4").Value = "QUALITE" Then
 NomDossier = Range("AE13")
 Adresse_recepteur = Range("Z13")
 
 'RH'
ElseIf Range("D4").Value = "RH" Then
 NomDossier = Range("AE15")
 Adresse_recepteur = Range("Z15")
 
 'PROD B21'
ElseIf Range("D4").Value = "PROD B21" Then
 NomDossier = Range("AE14")
 Adresse_recepteur = Range("Z14")
 
'V-LOG'
ElseIf Range("D4").Value = "V-LOG" Then
 NomDossier = Range("AE16")
 Adresse_recepteur = Range("Z16")
 
 'IT'
ElseIf Range("D4").Value = "IT" Then
 NomDossier = Range("AE17")
 Adresse_recepteur = Range("Z17")
 
  'PROD B41'
ElseIf Range("D4").Value = "PROD B41" Then
 NomDossier = Range("AE18")
 Adresse_recepteur = Range("Z18")
 
End If
 
'CREATION DU NOM DU FICHIER'
NomFournisseur = Range("G5").Value
Emetteur = Range("D5").Value
NomFichier = ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
FichierAtester = NomDossier & ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
 
'TEST SI LE FICHIER EXISTE'
Fichier_existe = Dir(FichierAtester)
 
While Fichier_existe <> ""
    ID = ID + 1
    FichierAtester = NomDossier & ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
    NomFichier = ID & " " & "Demande d'achat_" & NomFournisseur & "_" & Emetteur & "_" & Day(Date) & "_" & Month(Date) & "_" & Year(Date) & ".xlsm"
    Fichier_existe = Dir(FichierAtester)
Wend
 
If Fichier_existe = "" And Range("D4").Value <> "" And Range("D5").Value <> "" And Range("G5").Value <> "" Then
    On Error Resume Next
 
    ' Creation de l'adresse mail de l'emetteur'
    Adresse_emetteur = Replace(Adresse_emetteur, " ", ".")
    Range("X1").Value = Adresse_emetteur & "@velux.com"
 
    'actualisation du statut'
    Range("J5").Value = ID
    Range("M31").Interior.ColorIndex = 46
    Range("D3").Value = Date_DA
 
 
    'Envoie par mail au chef de service'
    ThisWorkbook.SendMail Adresse_recepteur, "Demande d'achat"
 
    'eregistrement d'une copie dans le repertoire'
    ActiveWorkbook.SaveCopyAs NomDossier & NomFichier
 
    Range("D4:D5").Value = ""
    Range("G5").Value = ""
    Range("B7:J46").Value = ""
 
 
Else
MsgBox ("Erreur : Service, Emetteur ou Fournisseur inconnu ")
End If
ActiveSheet.Protect Password:="CIA"
End Sub