Erreur Automation dans IndicateurCommune

**Le gris** · 02/01/2008, 12h30

bonjour à tous,
j'ai un serieux problème de puis quelques jour que j'ai du mal à resoudre:

j'utilise vb/postgresql avec pgodbc.
J'ai une procedure qui me permet de remplir un tableau à deux dimensions et lorsque qu'elle est appellée, l'execution est partielle et à un moment il met "Erreur Automation". Voila une capture http://www.mediadata.ci/public/eproximus.jpg

je vous presente le code:

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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
 
Function IndicateurCommune(Valeur As Integer)
'=====DECLARATION=====================
Dim sql As String
Dim RSIndic, RSAnon, RSCom, RSTyp, RS As ADODB.Recordset
Dim Com
Dim i, j, Nap, RegieA As Integer
'=====================================
On Error GoTo Et
'===== Spécification de la grille ====
GrdIndCommune.Clear
i = GrdIndCommune.Rows
GrdIndCommune.Rows = 2
GrdIndCommune.Cols = 2
GrdIndCommune.FixedRows = 1
GrdIndCommune.FixedCols = 1
GrdIndCommuneP.Rows = 2
GrdIndCommuneP.Cols = 2
GrdIndCommuneP.FixedRows = 1
GrdIndCommuneP.FixedCols = 1
'======================================
Set RS = New ADODB.Recordset
Set RSIndic = New ADODB.Recordset
Set RSAnon = New ADODB.Recordset
Set RSCom = New ADODB.Recordset
 
If CboCat.text = "Tous" Or CboCat.text = "" Then
    sql = "select distinct Annonceur from Annonceur"
Else
    sql = "select distinct Annonceur,Categorie from Annonceur where Categorie = '" & MajCote(CboCat.text) & "' order by Annonceur Desc"
End If
 
RSAnon.Open sql, Db, adOpenKeyset, adLockOptimistic
 
'initialisation de variable
i = 1
j = 1
Do While Not RSAnon.EOF
    If i >= GrdIndCommune.Cols Then GrdIndCommune.Cols = i + 1
    GrdIndCommune.Col = i
    GrdIndCommune.Row = 0
    GrdIndCommune.text = RSAnon!annonceur
    i = i + 1
    If j >= GrdIndCommuneP.Cols Then GrdIndCommuneP.Cols = j + 1
    GrdIndCommuneP.Col = j
    GrdIndCommuneP.Row = 0
    GrdIndCommuneP.text = RSAnon!annonceur
    j = j + 1
    RSAnon.MoveNext
Loop
RSAnon.Close
 
sql = "SELECT distinct Carto.commune,Carto.Campagne,Campagne.Fin,Campagne.Debut" _
& " from Carto inner join Campagne on Carto.Campagne=Campagne.Campagne" _
& " where ((Campagne.Debut <= " & Date_Deb & " and Campagne.Fin >= " & Date_Fin & ") or" _
& " (Campagne.Debut >= " & Date_Deb & " and Campagne.Fin <= " & Date_Fin & ") or" _
& " (Campagne.Fin >= " & Date_Deb & " and Campagne.Fin <= " & Date_Fin & ") or" _
& " (Campagne.Debut >= " & Date_Deb & " and Campagne.Debut <= " & Date_Fin & "))" _
& " order by Carto.commune"
 
'=====================================================================
'=  BOUCLE PERMETTANT LA CREATION DE LA COLONNE COMMUNE DE LA GRILLE =
'=====================================================================
 
    RSCom.Open sql, Db, adOpenKeyset, adLockOptimistic
    i = 1
    j = 1
    Dim nape As String
    Do While Not RSCom.EOF
    If RSCom!Commune <> nape Then
        If i >= GrdIndCommune.Rows Then GrdIndCommune.Rows = i + 1
        GrdIndCommune.Row = i
        GrdIndCommune.Col = 0
        GrdIndCommune.text = RSCom!Commune
        i = i + 1
        If j >= GrdIndCommuneP.Rows Then GrdIndCommuneP.Rows = j + 1
        GrdIndCommuneP.Row = j
        GrdIndCommuneP.Col = 0
        GrdIndCommuneP.text = RSCom!Commune
        j = j + 1
        nape = RSCom!Commune
        RSCom.MoveNext
    Else
    RSCom.MoveNext
    End If
    Loop
RSCom.Close
 
'=====================================================================
'= REMPLISSAGE DE LA GRILLE CREER
'=====================================================================
    Dim ASK As String
    Dim JSK As String
    Dim LibLine, LibCol As String
 Nap = Valeur
  For j = 1 To GrdIndCommune.Cols - 1
    For i = 1 To GrdIndCommune.Rows - 1
        'LibLine = MajCote(GrdIndCommune.TextMatrix(i, 0))
        'LibCol = MajCote(GrdIndCommune.TextMatrix(0, j))
        If CboType = "Spectaculaire" Or CboType = "" Then
            sql = "SELECT Campagne.Annonceur,Carto.Regie,Carto.commune,count(Carto.EMPLCMT) as NbrePan" _
            & " from Carto inner join Campagne on Carto.Campagne=Campagne.Campagne" _
            & " where ((Campagne.Debut <= " & Date_Deb & " and Campagne.Fin >= " & Date_Fin & ") or" _
            & " (Campagne.Debut >= " & Date_Deb & " and Campagne.Fin <= " & Date_Fin & ") or" _
            & " (Campagne.Fin >= " & Date_Deb & " and Campagne.Fin <= " & Date_Fin & ") or" _
            & " (Campagne.Debut >= " & Date_Deb & " and Campagne.Debut <= " & Date_Fin & "))" _
            & " and Carto.commune = '" & MajCote(GrdIndCommune.TextMatrix(i, 0)) & "'" _
            & " and Carto.Regie = '" & MajCote(CboType.text) & "' and Campagne.Annonceur = '" & MajCote(GrdIndCommune.TextMatrix(0, j)) & "'" _
            & " GROUP BY Campagne.Annonceur,Carto.Regie,Carto.commune"
        ElseIf CboType = "Tous" Then
            sql = "SELECT distinct Campagne.Annonceur,count(Carto.emplacement) as NbrePan" _
            & " from Carto inner join Campagne on Carto.Campagne=Campagne.Campagne" _
            & " where ((Campagne.Debut <= " & Date_Deb & " and Campagne.Fin >= " & Date_Fin & ") or" _
            & " (Campagne.Debut >= " & Date_Deb & " and Campagne.Fin <= " & Date_Fin & ") or" _
            & " (Campagne.Fin >= " & Date_Deb & " and Campagne.Fin <= " & Date_Fin & ") or" _
            & " (Campagne.Debut >= " & Date_Deb & " and Campagne.Debut <= " & Date_Fin & "))" _
            & " and Carto.commune = '" & MajCote(GrdIndCommune.TextMatrix(i, 0)) & "' and Campagne.Annonceur LIKE %'" & MajCote(GrdIndCommune.TextMatrix(0, j)) & "'%" _
            & " GROUP BY Campagne.Annonceur,Carto.commune"
        Else
        sql = "SELECT distinct Campagne.Annonceur,Carto.commune,count(Carto.emplacement) as NbrePan" _
            & " from Carto inner join Campagne on Carto.Campagne=Campagne.Campagne" _
            & " where ((Campagne.Debut <= " & Date_Deb & " and Campagne.Fin >= " & Date_Fin & ") or" _
            & " (Campagne.Debut >= " & Date_Deb & " and Campagne.Fin <= " & Date_Fin & ") or" _
            & " (Campagne.Fin >= " & Date_Deb & " and Campagne.Fin <= " & Date_Fin & ") or" _
            & " (Campagne.Debut >= " & Date_Deb & " and Campagne.Debut <= " & Date_Fin & "))" _
            & " and Carto.commune = '" & MajCote(GrdIndCommune.TextMatrix(i, 0)) & "'" _
            & " and Campagne.Annonceur = '" & MajCote(GrdIndCommune.TextMatrix(0, j)) & "' and Carto.emplacement not in (select Carto.emplacement from Carto where Carto.Regie = 'Spectaculaire')" _
            & " GROUP BY Campagne.Annonceur,Carto.commune"
 
        End If
        RSIndic.Open sql, Db, adOpenKeyset, adLockOptimistic
 
        If RSIndic!NbrePan > 0 Then
            RegieA = RSIndic!NbrePan
        Else
            RegieA = 0
        End If
        If Nap > 0 Then
            Com = Format((RegieA / Nap) * 100, "00.00")
        Else
            Com = 0
        End If
        GrdIndCommune.TextMatrix(i, j) = RegieA
        GrdIndCommuneP.TextMatrix(i, j) = Com
        RSIndic.Close
    Next i
  Next j
Unload Entree
 On Error GoTo 0
  Exit Function
Et:
    If Err = 3021 Then
        RegieA = 0
        Resume Next
    Else
       Err_Type = MessageErreur(Err, "IndicateurCommune")
       Select Case Err_Type
              Case 1: Resume
              Case 2: Resume Next
              Case 3: Exit Function
              Case 4: End
        End Select
    End If
End Function

salut à tous
dans l'imprime ecran, comme indiqué ci dessus, certaines cellules snt remplies tandis qu'une bonne partie ne l'est pas...

quelqu'un a une idée?

slt à tous,
y a t il quelqu'un pour m'aider?