[VBA-E]erreur d'execution '9'
bonjour le code suivant est pour vba excel
en gros cette procedure consiste a ouvrir un fichier (A) sur un serveur different du fichier excel (B)appelant le code vba
le progr va copier certaines cases du fichier A pour le coller dans le fichier B
le programme marche une fois si on tente de le reutiliser une seconde fois , ca bug et ca me donne un message d'erreur :
erreur d'execution '9' : l'indice n'appartient pas à la selection
l'erreur est constaté par le systeme à la ligne :
Code:
j2 = UBound(letbl3())
Code:
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
|
Sub verifexistnvxope()
Dim i, j, k, j2, i2, nbcol, var2, nb3 As Integer
Dim objFeuille As Worksheet
Dim mess, mess2 As String
Dim nomcol As Integer
Dim Existence_Dossier2 As Variant
Dim leDossier, verifsuivi2006 As String
Dim letbl2(), letbl3(), Fichier2 As String
Application.Workbooks.Open ("\\Icadefs01\clients\A-C\AFL\Suivi opérationnel\Suivi Des Dossiers 2006.xls")
var2 = 0
j = 0
i = 0
j2 = 0
i2 = 0
k = 0
nbcol = 0
nomcol = 0
nb3 = 0
mess = ""
mess2 = ""
verifsuivi2006 = ""
leDossier = ""
i = Application.ActiveWorkbook.Sheets.Count
For j = 1 To i
If Application.ActiveWorkbook.Sheets(j).Name = "Réceptions AP3" Then
k = j
Exit For
End If
Next
If k <> 0 Then
Set objFeuille = ActiveWorkbook.ActiveSheet
Application.ActiveWorkbook.Sheets(k).Activate
i = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count
nbcol = ActiveWorkbook.ActiveSheet.UsedRange.Columns.Count
' For j = 1 To nbcol
'If LCase(ActiveWorkbook.ActiveSheet.UsedRange.Cells(1, j).Value) = "" Then
'End If
' Next
For j = 2 To i
If LCase(Application.ActiveSheet.Cells(j, 33).Value) = "o" Then
ReDim Preserve letbl2(nb3)
letbl2(nb3) = Application.ActiveSheet.Cells(j, 2).Value
mess = mess & " " & letbl2(nb3)
nb3 = nb3 + 1
End If
Next
'MsgBox mess
'MsgBox UBound(letbl2())
End If
If k = 0 Then
MsgBox "le système n'a pas pu trouvé d'onglet nommé 'Réceptions AP3' dans le fichier 'Suivi Des Dossiers 2006.xls" & _
Chr(10) & "La procédure de vérification d'existence de nouvelles opérations n'a pas pu être effectuée", vbExclamation, "Avertissements"
End If
Application.ActiveWorkbook.Close SaveChanges:=False
'------------------------------------------------------------------------
leDossier = ActiveWorkbook.Path
nb3 = 0
If Dir(leDossier & "\" & "suivi_conseil_2006_icade.xls", vbNormal) <> "" Then
Application.Workbooks.Open (leDossier & "\" & "suivi_conseil_2006_icade.xls")
Application.ActiveWorkbook.Sheets("Suivi Dossiers 2006").Activate
i = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count
i2 = UBound(letbl2())
For j2 = 0 To i2
For j = 2 To i
If LCase(ActiveWorkbook.ActiveSheet.Cells(j, 1).Value) = LCase(letbl2(j2)) Then
var2 = var2 + 1
End If
Next
If var2 = 0 Then
ReDim Preserve letbl3(nb3)
letbl3(nb3) = letbl2(j2)
mess2 = mess2 & " " & letbl3(nb3)
nb3 = nb3 + 1
End If
var2 = 0
Next
j2 = UBound(letbl3())
i2 = 0
i = ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count + 1
For j = i To i + UBound(letbl3()) + 1
If j2 >= i2 Then
ActiveWorkbook.ActiveSheet.Cells(j, 1).Value = letbl3(i2)
End If
i2 = i2 + 1
Next
Application.ActiveWorkbook.Close SaveChanges:=True
Else
MsgBox "Le fichier 'suivi_conseil_2006_icade.xls' dans le dossier '" & _
leDossier & "' n'existe pas." & Chr(10) & _
"La procédure de vérification d'existence de nouvelles opérations n'a pas pu être effectuée, si nouvelles opérations il y a...", vbExclamation, "Avertissements"
End If
End Sub |
