Bonjour à tous,
j'ai fait un programme qu doit enregistré dans une table(vide pour le moment) que j'ai créé des valeurs de tolérances, la date ou le rapport a été enregistré,le commentaire affiché dans un tableau excel. La date doit etre mis à jour quand on imprime les résultats sur excel.Voila le code vba:

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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
' enregistrement commentaires dans la base de données IRIS
Application.ScreenUpdating = True 'active mise à jour ecran pendant execution
 
For Y = 10 To 20
    If Worksheets("FP56").Cells(Y, 9).Value = "" Then
    Else:
        If Cells(Y, 5).Value < Cells(Y, 6).Value Or Cells(Y, 5).Value > Cells(Y, 7).Value Then
            If Worksheets("FP56").Cells(Y, 8).Value = "" Then
                Worksheets("FP56").Cells(Y, 1).Select
                Com = InputBox("Cet essai est hors tolérances. Vous devez entrer un commentaire!", "Commentaire", , 350, 350)
                Worksheets("FP56").Cells(Y, 8).Value = Com
 
                ' connection base de données, mise à jour et fermeture.
                Set rs = New ADODB.Recordset
                rs.Open "SELECT*FROM rsResults WHERE DBNumber=" & Numres, cN, adOpenKeyset, adLockOptimistic
                rs!DBComment = Com
 
             End If
        End If
    End If
Next Y
For X = 23 To 33
    If Worksheets("FP56").Cells(X, 9).Value = "" Then
    Else:
        If Cells(X, 5).Value < Cells(X, 6).Value Or Cells(X, 5).Value > Cells(X, 7).Value Then
            If Worksheets("FP56").Cells(X, 8).Value = "" Then
                Worksheets("FP56").Cells(X, 1).Select
                Com = InputBox("Cet essai est hors tolérances. Vous devez entrer un commentaire!", "Commentaire", , 350, 350)
                Worksheets("FP56").Cells(X, 8).Value = Com
                ' connection base de données, mise à jour et fermeture.
                Set rs = New ADODB.Recordset
                rs.Open "SELECT*FROM rsResults WHERE DBNumber=" & Numres, cN, adOpenKeyset, adLockOptimistic
                    rs!DBComment = Com
 
                rs.Close
                cN.Close
                Set rs = Nothing
                Set cN = Nothing
             End If
        End If
    End If
Next X
 
Worksheets("FP56").Range("C4").Select
 
 
End Sub
' mise à jour de la date d'enregistrement du rapport et tolérances
Sub date_rapport56()
Application.ScreenUpdating = False
 
 
Dim rs As New ADODB.Recordset
Dim cN As New ADODB.Connection
Dim DateRapport As Date 'date impression rapport
Dim I As Integer
Dim J As Integer
Dim LB As Single 'tolérance basse
Dim LH As Single 'tolérance haute
Dim Numres As Long 'numéro du résultat dans base de donnée IRIS
DateRapport = Date
 
    Set cN = New ADODB.Connection
    Set rs = New ADODB.Recordset
    dbPath = Path
 
For I = 10 To 20
    If Worksheets("FP56").Cells(I, 9).Value = "" Then
    Else:
 
        LB = Worksheets("FP56").Cells(I, 6).Value
        LH = Worksheets("FP56").Cells(I, 7).Value
        ' connection base de données, mise à jour et fermeture.
        cN.ConnectionString = "Provider=SQLOLEDB;Data Source=VERPACWS016\ENTERPRISE;Initial Catalog=enterprise; User ID=sa;Password=Alpha2000;"
        cN.Open
        rs.Open "SELECT*FROM rsResults WHERE DBNumber=" & Numres, cN, adOpenKeyset, adLockOptimistic
                Worksheets("FP56").Cells(I, 9).Value = DateRapport
                rs!DBDateRapport = DateRapport
                rs!DBLimitBasse = LB
                rs!DBLimitHaute = LH
 
    End If
Next I
For J = 23 To 33
    If Worksheets("FP56").Cells(J, 9).Value = "" Then
    Else:
 
        LB = Worksheets("FP56").Cells(J, 6).Value
        LH = Worksheets("FP56").Cells(J, 7).Value
        ' connection base de données, mise à jour et fermeture.
 
        Set rs = New ADODB.Recordset
        rs.Open "SELECT*FROM rsResults WHERE DBNumber=" & Numres, cN, adOpenKeyset, adLockOptimistic
                Worksheets("FP56").Cells(J, 9).Value = DateRapport
                rs!DBDateRapport = DateRapport
                rs!DBLimitBasse = LB
                rs!DBLimitHaute = LH
       rs.Close
       cN.Close
       Set rs = Nothing
       Set cN = Nothing
 
    End If
Next J
End Sub
 
'impression des résultats de MAP sur le dossier de test
Sub imprimer56_MAP()
 
With Worksheets("FP56").PageSetup
    .LeftMargin = Application.CentimetersToPoints(1.2)
    .RightMargin = Application.CentimetersToPoints(1)
    .TopMargin = Application.CentimetersToPoints(9.5)
    .BottomMargin = Application.CentimetersToPoints(14.5)
    .Orientation = xlPortrait
    .PrintArea = Range(Cells(9, 9), Cells(9, 1).End(xlDown)).Address
End With
 
MsgBox "mettez la feuille de test dans l'imprimante!"
'Worksheets("FP56").PrintPreview
Worksheets("FP56").PrintOut
 
End Sub
'impression des résultats de qualification sur le dossier de test
Sub imprimer56_QUALIF()
 
With Worksheets("FP56").PageSetup
    .LeftMargin = Application.CentimetersToPoints(1.2)
    .RightMargin = Application.CentimetersToPoints(1)
    .TopMargin = Application.CentimetersToPoints(19.5)
    .BottomMargin = Application.CentimetersToPoints(1)
    .Orientation = xlPortrait
    .PrintArea = Range(Cells(22, 9), Cells(22, 1).End(xlDown)).Address
End With
MsgBox "mettez la feuille de test dans l'imprimante!"
'Worksheets("FP56").PrintPreview
Worksheets("FP56").PrintOut
date_rapport56
 
 
End Sub
Et voici le message d'erreur venant du rs!DBComment=com, rs!DB.....
erreur d'execution 3021 BOF ou EOF est egal à true ou
l'enregistrement actuel a été supprimé. L'opération demandé necessite un
enregistrement actuel.
J'ai besoin de votre aide car je ne vois pas pourquoi.Merci d'avance pour vos réponses