Erreur de compilation

**nadeson** · 15/05/2012, 14h24

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

**Jean-Philippe André** · 15/05/2012, 16h06

salut,

comme ton code a tendance à être identique entre tes différentes procédures, peux-tu nous donner seulement la procédure qui est concernée par ton bug actuel stp ?

D'autre part, lorsqu'on utilise un recordset, on passe souvent par une boucle avec des tests sur les débuts/fins du recordset.

Enfin, tu mets des valeurs dans ton recordset, mais ne le mets pas à jour avec un Update, est-ce voulu ?

Quelques lectures à ce sujet :
http://vb.developpez.com/bidou/recor...?page=sommaire

**nadeson** · 15/05/2012, 16h49

Merci pour ta réponse

comme ton code a tendance à être identique entre tes différentes procédures, peux-tu nous donner seulement la procédure qui est concernée par ton bug actuel stp ?

la procédure concernée par le bug sont toutes les parties ou il y'a rs! égal quelque chose donc c'est à dire

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
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

et cette partie là aussi

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
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

D'autre part, lorsqu'on utilise un recordset, on passe souvent par une boucle avec des tests sur les débuts/fins du recordset.

Tu parles de If Not rs.EOF Then While Not rs.EOF......Wend End if c'est sa? Si oui comment l'intégrer à mon programme?

Enfin, tu mets des valeurs dans ton recordset, mais ne le mets pas à jour avec un Update, est-ce voulu ?

Non perso c'est pas voulu, je n'y ai pas pensé et comment j'utilise l'update?
Merci d'avance pour ta réponse

**Jean-Philippe André** · 15/05/2012, 17h04

pour l'ensemble de tes questions, je te renvoie au tuto indiqué dans le post précédent

**nadeson** · 16/05/2012, 09h01

Merci pour ta réponse.
j'ai lu le lein en entier et je crois avoir compris.Voila ce que j'ai modifié à mon programmev au niveau du commentaire par exemple

Code :

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

1
2
3
4
5
6
7
If Not rs.EOF Then
                 While Not rs.EOF
                    rs!DBComment = Com
                    rs.Update
                    rs.MoveNext
                  Wend
               End If

Le programme s'execute normalement, mais les commentaires que j'entre ne sont pas enrgistré dans la colonne DBComment de la table rsResults

**AlainTech** · 17/05/2012, 21h16

Bonjour,

Je te conseille vivement ce tutoriel:
http://darkvader.developpez.com/tuto...isual-basic-6/

Et principalement le paragraphe II-3. Les outils dédiés au débogage

Erreur de compilation

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager