Bonjour a tous,
Je developpe actuellement un fichier sous EXCEL 2000 pour recuperer des valeurs sur un automate TSX 3721 via un serveur OPC FACTORY SERVER Ver 3.30 DEMO.
Voici mon probleme:
La connection se passe bien, la creation des groupes egalement ainsi que la creation des items.
Par contre lorsque je viens lancer la commande
Code : Sélectionner tout - Visualiser dans une fenêtre à part
GR0.SyncRead OPC_DS_DEVICE, NBITEMS, tabItemsHdlSrv, pValues, pErrors, pQualites, pTimeStamp
la page de diagnostique de OPC FACTORY SERVER me met ce message en rouge "NETMAN : Request Time Out for device : UNTLW01:0.254.0" et celui ci "Sync Read failure:UNTLW01.0.254.0".

Voici mon prog :
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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
Option Base 1 
 
Const ProgID$ = "Schneider-Aut.OFSSimu" 'Nom du simulateur OPC Schneider. 
Const ProgID1$ = "Schneider-Aut.OFS" 'Nom du serveur OPC Schneider. 
Const dwlangld_ENGLISH = &H409 'Message OPC en langue Anglaise. 
Const dwlangld_FRANCAIS = &H40C 'Message OPC en langue Française. 
Const S_OK = 0 'Initialisation S_OK. 
Const OPC_DS_DEVICE = 2 'Lecture du DEVICE. 
 
' *** Constantes application test 
Const NBITEMS = 20 'Nombre d'Items Max dans chaque groupe. 
 
' *** Définition des variables ** 
Dim hndClientItemCouter As Long ' 
Dim contiRead As Boolean ' 
Dim isFormActivated As Boolean ' 
Dim isShuttingDown As Boolean 'True when continuous read over. 
Dim isErrorStringFAILED As Boolean 'Avoid infinite recursive error. 
Dim driverPLC As String 'Nom du driver selectionné. 
Dim PrgID As String 'Nom du serveur selectionné. 
Dim HostServeur As String 'Nom du PC serveur OFS 
Dim NumGR As Variant 'Numéro du groupe. 
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
Dim WithEvents OpcFactoryServer As OPCServer 'Interface OPC Automation2 
 
'========================================================================================== 
'*********************************** LISTE GROUPES ************************************* 
Dim ListOfsGroups As OPCGroups 'Liste des groupes 
'----- GR0 ------------ 
Dim WithEvents GR0 As OPCGroup 'Un Groupe GR0 contient le mot fin de cycle frettage et 3 autres parametres libres 
Dim WithEvents GR1 As OPCGroup 'Un Groupe GR1 contient le Nom operateur et les parametres Gamme courante 
Dim WithEvents GR2 As OPCGroup 'Un Groupe GR2 contient les valeurs Course, Force 
 
'========================================================================================== 
'*********************************** COLLECTION ITEMS ************************************* 
Dim GRItemCollection As OPCItems 'Collection d'Items 
Const IdentMot = "%MW" 
Dim Mot, Mot2, ProgVide 
Dim NumProg As Byte 'Index num prog 
'----- GR0 (mot fin de cycle frettage)------------ 
Const NumgrpGR0 = 0 'Numéro du groupe N°0. 
Const nbritemsGR0 = 1 'Nombre d'Items dans le groupe (%MW200 A %MWx). 
Dim tabItmGR0HndCli(1 To nbritemsGR0) As Long ' 
Dim tabItmGR0HndSrv(1 To nbritemsGR0) As Long ' 
Dim hndSrvGrpGR0 As Long ' 
Const NbEcrItemGR0 = 20 'Nombre d'Items en écriture. 
 
 
'----- GR1 (Nom operateur,Gamme courante)------------ 
Const NumgrpGR1 = 1 'Numéro du groupe N°1. 
Const nbritemsGR1 = 2 'Nombre d'Items dans le groupe (%MW200 A %MWx). 
Dim tabItmGR1HndCli(1 To nbritemsGR1) As Long ' 
Dim tabItmGR1HndSrv(1 To nbritemsGR1) As Long ' 
Dim hndSrvGrpGR1 As Long ' 
Const NbEcrItemGR1 = 20 'Nombre d'Items en écriture. 
Dim IndItemGR1 
Dim LongItemGR1 
 
 
'----- GR2 (Course, Force)------------ 
Const NumgrpGR2 = 2 'Numéro du groupe N°2. 
Const nbritemsGR2 = 2 'Nombre d'Items dans le groupe (%MW200 A %MWx). 
Dim tabItmGR2HndCli(1 To nbritemsGR2) As Long ' 
Dim tabItmGR2HndSrv(1 To nbritemsGR2) As Long ' 
Dim hndSrvGrpGR2 As Long ' 
Const NbEcrItemGR2 = 20 'Nombre d'Items en écriture. 
Dim IndItemGR2 
 
 
'========================================================================================== 
'************************ ACTIVATION DU SERVEUR OU SIMULATEUR OPC ************************* 
Function Connect() 
PrgID = ProgID1$ 
Set OpcFactoryServer = New OPCServer 
OpcFactoryServer.Connect PrgID$ 
If (Err.Number <> S_OK) Or (OpcFactoryServer Is Nothing) Then 
warning "1000: error during creating " + PrgID$, (Err.Number) 
End If 
Set ListOfsGroups = OpcFactoryServer.OPCGroups 'Initialisation de la liste des groupes 
' Caractéristiques de tous les groupes. 
ListOfsGroups.DefaultGroupIsActive = False 'Groupes désactivés. 
ListOfsGroups.DefaultGroupUpdateRate = 2000 '500 'Temps de cycle(ms). 
ListOfsGroups.DefaultGroupDeadband = 1 ' 
ListOfsGroups.DefaultGroupLocaleID = dwlangld_FRANCAIS 'Messages en Français. 
'----- GR0 (mot fin de cycle frettage)------------ 
If Not createGR0Grp() Then isFormActivated = True 'Creation OPC Group GR0;appel sous-programme createGR0Grp 
'----- GR1 (Nom operateur,Gamme courante)------------ 
If Not createGR1Grp() Then isFormActivated = True 
'----- GR2 (Course, Force)------------ 
If Not createGR2Grp() Then isFormActivated = True 
'End If 
End Function 
'========================================================================================== 
'*********************************** CREATION GR0 ***************************************** 
Function createGR0Grp() As Boolean 
Dim rateDummy As Long 
Dim ItemsDef(nbritemsGR0) As String 'Tableau des noms Item. 
Dim i 
On Error Resume Next 
Set GR0 = ListOfsGroups.Add("GR0") 'Initialise le groupe GR0 à la liste des groupes. 
If (Err.Number <> S_OK) Or (ListOfsGroups Is Nothing) Then 
warning "1010: can't load the main OPC group", (Err.Number) 
End If 
Set GRItemCollection = GR0.OPCItems 'Initialise la collection d'Items. 
GR0.UpdateRate = 200 
 
'---Definition des Items du groupe GR0.--- 
' Donner le premier mot automate et la longueur de la liste de données 
'For i = 1 To nbritemsGR0 
'Mot = IdentMot & 200 + (i - 1) * 20 & ":20" 
ItemsDef(1) = "UNTLW01:0.254.0!%MW6:4" 'ItemsDef(1) = "UNTLW01:0.254.0!%PremierMot:Longueur" 
'Next 
'---Appel procedure création d'Items.--- 
createItems ItemsDef(), tabItmGR0HndCli(), tabItmGR0HndSrv(), nbritemsGR0 'Appel sous-programme "createItems" 
GR0.IsActive = True 
GR0.IsSubscribed = True 
 
End Function 
'========================================================================================== 
'*********************************** CREATION GR1 ***************************************** 
Function createGR1Grp() As Boolean 
Dim rateDummy As Long 
Dim ItemsDef(nbritemsGR1) As String 'Tableau des noms Item. 
Dim i 
On Error Resume Next 
Set GR1 = ListOfsGroups.Add("GR1") 'Initialise le groupe GR1 à la liste des groupes. 
If (Err.Number <> S_OK) Or (ListOfsGroups Is Nothing) Then 
warning "1010: can't load the main OPC group", (Err.Number) 
End If 
Set GRItemCollection = GR1.OPCItems 'Initialise la collection d'Items. 
GR1.UpdateRate = 200 
 
For i = 1 To nbritemsGR1 
If i = 1 Then 
IndItemGR1 = 100: LongItemGR1 = 12 
ElseIf i = 2 Then 
IndItemGR1 = 60: LongItemGR1 = 20 
End If 
 
'---Definition des Items du groupe GR1.--- 
' Donner le premier mot automate et la longueur de la liste de données 
 
ItemsDef(i) = "UNTLW01:0.254.0!" & IdentMot & IndItemGR1 & ":" & LongItemGR1 'ItemsDef(1) = "UNTLW01:0.254.0!%PremierMot:Longueur" 
Next 
'---Appel procedure création d'Items.--- 
createItems ItemsDef(), tabItmGR1HndCli(), tabItmGR1HndSrv(), nbritemsGR1 'Appel sous-programme "createItems" 
GR1.IsActive = True 
GR1.IsSubscribed = True 
End Function 
 
'========================================================================================== 
'*********************************** CREATION GR2 ***************************************** 
Function createGR2Grp() As Boolean 
Dim rateDummy As Long 
Dim ItemsDef(nbritemsGR2) As String 'Tableau des noms Item. 
Dim i 
On Error Resume Next 
Set GR2 = ListOfsGroups.Add("GR2") 'Initialise le groupe GR2 à la liste des groupes. 
If (Err.Number <> S_OK) Or (ListOfsGroups Is Nothing) Then 
warning "1010: can't load the main OPC group", (Err.Number) 
End If 
Set GRItemCollection = GR2.OPCItems 'Initialise la collection d'Items. 
GR2.UpdateRate = 200 '200 
 
For i = 1 To nbritemsGR2 
IndItemGR2 = 1001 + (i - 1) * 1500
'Definition des Items du groupe GR1. 
ItemsDef(i) = "UNTLW01:0.254.0!" & IdentMot & IndItemGR2 & ":1500" '":1500" 'ItemsDef(1) = "UNTLW01:0.254.0!%MW2501:700" 
Next 
'---Appel procedure création d'Items.--- 
createItems ItemsDef(), tabItmGR2HndCli(), tabItmGR2HndSrv(), nbritemsGR2 'Appel sous-programme "createItems" 
GR2.IsActive = True 
GR2.IsSubscribed = True 
End Function 
'========================================================================================== 
'*********************************** CREATION ITEMS ***************************************** 
' Creation items of group: IN:ItemsDef() name of items, OUT:tabItemsHdlSrv() 
Sub createItems(ItemsDef() As String, tabItemsLocHdlClient() As Long, _ 
tabItemsHdlSrv() As Long, nbrItems As Long) 
 
Dim indItem% 
Dim ItemsActivity(NBITEMS) As Boolean 
Dim tabItemsLocHdlSrv() As Long 
hndClientItemCouter = 0 
 
For indItem% = 1 To nbrItems 
ItemsActivity(indItem%) = True ' Item actif par défaut 
hndClientItemCouter = hndClientItemCouter + 1 
tabItemsLocHdlClient(indItem%) = hndClientItemCouter 
Next 
 
On Error Resume Next 
' Creation de tous les Items OPC pour le Groupe 
For indItem% = 1 To nbrItems 
GRItemCollection.AddItem ItemsDef(indItem%), tabItemsLocHdlClient(indItem%) 
tabItemsHdlSrv(indItem%) = GRItemCollection.Item(indItem%).ServerHandle 
If Err.Number <> S_OK Then 
warning "1040: Can't create the items " + "of the group" + vbCrLf + vbCrLf + _ 
"Possible Causes : " + vbCrLf, (Err.Number) 
End If 
Next 
On Error GoTo 0 
End Sub 
'========================================================================================== 
'*********************************** LECTURE DU GROUPE ************************************ 
Function readGroup(interfaceOfGroup As OPCGroup, tabItemsLocHdlClient() As Long, tabItemsHdlSrv() As Long, NBITEMS As Long, NumGR As Variant) 
Dim numItem As Long 
Dim pValues() As Variant 
Dim pQualites As Variant 
Dim pTimeStamp As Variant 
Dim pErrors() As Long 
 
'--- Lecture 
readGroup = False: 
On Error Resume Next 
On Error GoTo 0 
 
GR0.SyncRead OPC_DS_DEVICE, NBITEMS, tabItemsHdlSrv, _ 
pValues, pErrors, pQualites, pTimeStamp 
If Err.Number <> S_OK Then 
warning "1070: Echec lecture Synchrone", (Err.Number) 
End If 
'For numItem = LBound(pValues) To UBound(pValues) 
'GUIitemDisplayGR0 pValues(numItem), tabItemsLocHdlClient(numItem), pTimeStamp(numItem) 
'Next 
 
End Function
Est ce que quelqu'un aurait une reponse pour moi ca m'aiderais enormement

merci a tous