ketsiajulie
Messages postés3Date d'inscriptionvendredi 22 juillet 2011StatutMembreDernière intervention 3 août 2011
-
3 août 2011 à 12:01
cs_Julien39
Messages postés6414Date d'inscriptionmardi 8 mars 2005StatutModérateurDernière intervention29 juillet 2020
-
3 août 2011 à 13:00
'--------------------------------------------------------------------------------------------------------------------------------
'Configuration de la communication avec le serveur OPC
'---------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Dim WithEvents OpcFactoryServer As OPCServer 'Interface OPC Automatation2 avec Notification
Dim ListOfsgroups As OPCGroups 'Objet pour une liste de groupes
Dim WithEvents Group1 As OPCGroup 'Objet pour un groupe avec notification
Dim PremierCollectionitems As OPCItem 'Objet pour une collection d'Items
Dim ItemName1() As String 'Tableau de définition des Items
Dim HandleClient1() As Long 'Tableau de pointeur des Items Clients
Dim HandleServer1() As Long 'Tableau de pointeur des Items Serveur
Dim Erreur1() As Long 'Tableau de code d'erreu rendus par le serveur
Dim FinCreation As Boolean 'Flag de signalement de la fin de creation par le serveur
Const ProgID = "Schneider-Aut.OFS" 'Type de serveur OPC
Dim KSBAG As String 'Nom du PC serveur
Private Sub CommandButton1_Click()
Dim NbItem1 As Single
Dim Reponse As Integer
NbItem1 = 7
'Redimentionnement des tableaux en fonction du nombre d'items
ReDim ItemName1(NbItem1) As String
ReDim HandleClient1(NbItem1) As Long
ReDim HandleServer1(NbItem1) As Long
ReDim Erreur1(NbItem1) As Long
'Création des Groupes et des Items
If Not FinCreation Then
'Intionalitaion d'un serveur OPC automation 2.0
Set OpcFactoryServer = New OPCServer 'Connexion au serveur OPC
On Error GoTo Label1 'Si une erreur survient va au Label1
OpcFactoryServer.Connect ProgID
OpcFactoryServer.ClientName = "ksb" 'spécifie le nom du client
Set ListofsGroup = OpcFactoryServer.OPCGroups ' Création d'une instance pour ce client
'Ajout des Items au Group et recupération des pointeurs cotés serveur et le code d'erreur
PremierCollectionitems.AddItems NbItem1, ItemName1, HandleClient1, HandleServer1, Erreur1
Set Item1(1) = PremierCollectionitems.GetOPCItem(HandleServer1(1))
Set Item1(2) = PremierCollectionitems.GetOPCItem(HandleServer1(2))
Set Item1(3) = PremierCollectionitems.GetOPCItem(HandleServer1(3))
Set Item1(4) = PremierCollectionitems.GetOPCItem(HandleServer1(4))
Set Item1(5) = PremierCollectionitems.GetOPCItem(HandleServer1(5))
Set Item1(6) = PremierCollectionitems.GetOPCItem(HandleServer1(6))
Set Item1(7) = PremierCollectionitems.GetOPCItem(HandleServer1(7))
'Activation du Groupe (lecture), validation de la notification, mise à 1 du flag de création
Group1.IsActive = True
Group1.IsSubscribed = True
FinCreation = True
Exit Sub
Label1:
'Reponse = MsgBox("Erreur dans le nom du Poste Distant !", vbCritical, "Attention !")
Call MsgBox(Err.Description, vbOKOnly)
Resume Next
End Sub
Private Sub CommandButton2_Click()
If Not (OpcFactoryServer Is Nothing) Then
'suppression de tous les groupes OPC
If Not (ListOfsgroups Is Nothing) Then
Group1.IsSubscribed = True
ListOfsgroups.RemoveAll
Set ListOfsgroups = Nothing
End If
'Déconnexion du serveur
OpcFactoryServer.Disconnect
Set OpcFactoryServer = Nothing
FinCreation = False
Else
'Vider les groupes, vider le serveur
Set ListOfsgroups = Nothing
Set OpcFactoryServer = Nothing
End If
End Sub
Private Sub CommandButton3_Click()
Item1.Write (0)
End Sub
Sub Group1_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemsValues() As Long, IDENTIFIANT() As Variant, Erreur1() As Long)
Dim i As Variant
For i = 1 To 7
Cells(2 + i, 1) = IDENTIFIANT(i)
Next i
End Sub
ERREU Affiché: la déclaration de la procedure ne correspond pas a la descrition de l'évènement. Quelqu'un pourra t-il m'aider????
