Bonjour à tous,
Je vous expose mon petit souci qui me fais perdre la tete depuis 2 heures.

J'ai un fichier que je rempli et qui va écrire dans un autre fichier femré certaines données . Voici le code qui fonctionne très bien.

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
 
 
Function Recup_Analyse(ByVal Lig As Long) As String
Dim Res As String, St As String, Dem As String, Serv As String, Proj As String, Ech As String, NLot As String
Dim DteEnrg As Date
Dim c As Range
Dim i As Byte
 
With Sheets("Formulaire")
    Dem = .Range("C4").Value
    Serv = .Range("C5").Value
    Proj = .Range("C6").Value
    DteEnrg = CDate(.Range("C7").Value)
    Ech = .Range("B" & Lig).Value
    NLot = .Range("C" & Lig).Value
 
    Res = "',#" & DteEnrg & "#,'" & Dem & "','" & Serv & "','" & Proj & "','" & Ech & "','" & NLot
    For Each c In .Range("D" & Lig & ": M" & Lig)
        If c.Value = "O" Or c.Value = "o" Then
            Res = Res & "','" & .Cells(4, c.Column).Value
            i = i + 1
        End If
    Next c
End With
St = Application.Rept("','", 11 - i)
St = Left(St, Len(St) - 3)
Recup_Analyse = Res & St
End Function
 
'Procédure permettant de faire l'enregistrement des différentes données dans le fichhier base
Sub Enregistrement_Base()
Dim Cn As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Fichier As String, Feuille As String, strSQL As String
Dim NumEnrg As Long
Dim c As Range
 
'Définit le classeur fermé servant de base de données
Fichier = "P:\commun\Techniciens\F.ROLLIN\divers\Projet_DA\Base_Donnees_DA.xls"
'Nom de la feuille dans le classeur fermé
Feuille = "Base"
'--- Connexion ---
With Cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
End With
'-----------------
'Définit la requête permettant de récupérer le dernier numéro d'enregistrement
strSQL = "SELECT Max([N_Enregistrement]) FROM [" & Feuille & "$]"
Set Rst = Cn.Execute(strSQL)
NumEnrg = IIf(IsNull(Rst(0)), 0, Rst(0))
Set Rst = Nothing
 
With Sheets("Formulaire")
    For Each c In .Range("Reference")
        If c.Value <> "" Then
            'Définit la requête permettant d'écrire toutes les données.
            NumEnrg = NumEnrg + 1
            strSQL = "INSERT INTO [" & Feuille & "$] VALUES ('" & NumEnrg & Recup_Analyse(c.Row) & "')"
            Cn.Execute strSQL
           .Range("O" & c.Row).Value = NumEnrg
        End If
    Next c
End With
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
End Sub

Le problème est que pour la date si je rentre 04/07/2011 dans la cellule C7, je me retrouve avec 07/04/2011 dans mon fichier Base de données.

C'est assez surprenant par contre je n'arrive pas à savoir si cela vient du fichier demande d'analuse ou du fichier Base de données.

Par contre lorsque le jour est supérieur à 12, par exemple 13/05/2011, la date enregistrée dans le fichier base de données est le bon.

Avez vous une idée pour résoudre mon énigme???
Merci de votre aide
Fred