j'ai developpé cet application sur vba mais j'ai rien comme résultat
Code VBA : 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
Option Explicit
' Define variables
    Dim OPCServer As IOPCServerDisp
    Dim OPCItemMgt As IOPCItemMgtDisp
    Dim OPCItem As IOPCItemDisp
    Dim Updaterate As Long
    Dim ServerHdl As Long
    Dim ItemIDs(2) As String
    Dim ItemsDef(2) As String
    Dim AccessPaths(2) As String
    Dim ServerHandles(2) As Long
    Dim Active(2) As Boolean
    Dim ClientHandles(2) As Long
    Dim i As Integer
    Dim ItemObjects As Variant
    Dim Errors As Variant
    Dim Values As Variant
    Const progID$ = "Schneider-Aut.OFSAut" 'object "OPC Server"
    Const nbrItems = 2
    Dim hndClientItemCounter As Integer
    Dim io As IOPCSyncIODisp
   ' OPC constants: ref. OPC Foundation Task Force
     Public Const OPC_DS_DEVICE = 2 ' Read physically the DEVICE
    'excel
 
 
 
Sub monprog()
 
 
    ' Create link to OPC Server
      Set OPCServer = CreateObject(progID$) 'Create the OFS OPC Server
      If TypeName(OPCServer) = TypeName(Nothing) Then
        MsgBox "Server could not be accessed"
        Return 'no server
    End If
    ' Create a Group
    Updaterate = 500
    Set OPCItemMgt = OPCServer.AddGroup("Excel", True, Updaterate, 22, 1, 0, ServerHdl, Updaterate)
    If TypeName(OPCItemMgt) = TypeName(Nothing) Then
        MsgBox "OPC Group could not be created"
        Return   'no group
    End If
 
  ' prepare the items
  ItemIDs(0) = "TM221!%MW0"
  ItemIDs(1) = "TM221!%MF5"
  ItemsDef(0) = "TM221!%MW0"
  ItemsDef(1) = "TM221!%MF5"
        For i% = 0 To 1
            Active(i%) = True
            ClientHandles(i%) = i%
            ServerHandles(i%) = i%
            AccessPaths(i%) = ""
 
    Next i%
    ' Add the items
   createItems OPCItemMgt, ItemsDef(), ClientHandles(), ServerHandles()
 
    ' Read the values
 
   Set io = OPCItemMgt
io.OPCRead OPC_DS_DEVICE, 2, ServerHandles(), Values
 
 
            Sheets(1).Cells(1, 1).Value = Values(0)
           Sheets(1).Cells(1, 1).Value = Values(1)
 
End Sub
Sub createItems(interfaceOfGroup As Object, ItemsDef() As String, tabItemsLocHdlClient() As Long, tabItemsHdlSrv() As Long)
Dim indItem%, ptrItemMgt As IOPCItemMgtDisp ' Management of item.
' Passing parameters to "AddItems"
Dim ItemsActivity(nbrItems) As Boolean ' TRUE by default, items're activated
Dim tabItemsLocHdlSrv As Variant ' OUT: handle of items
Dim itemsErrors As Variant ' table of error per item
Dim ItemsObject As Variant ' table of created items
Dim accessPath(nbrItems) As String ' IN: empty accessPath for each item
For indItem% = 0 To nbrItems - 1 ' Preparing the prms for "AddItems"
ItemsActivity(indItem%) = True ' Item is activated by default
hndClientItemCounter = hndClientItemCounter + 1
tabItemsLocHdlClient(indItem%) = hndClientItemCounter ' Client Handle
Next
On Error Resume Next
Set ptrItemMgt = interfaceOfGroup
' Create all the OPC items for this group
Call ptrItemMgt.AddItems(nbrItems, ItemsDef, ItemsActivity, tabItemsLocHdlClient, tabItemsLocHdlSrv, itemsErrors, ItemsObject, accessPath)
For indItem% = 0 To nbrItems - 1 ' Successfully new added items. ...
tabItemsHdlSrv(indItem%) = tabItemsLocHdlSrv(indItem%)
Next
Set ptrItemMgt = Nothing
End Sub

qulqu'un peut m'aider