[clos] Client OPC VB [Fermé]

Signaler
Messages postés
3
Date d'inscription
vendredi 22 juillet 2011
Statut
Membre
Dernière intervention
3 août 2011
-
Messages postés
6414
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
29 juillet 2020
-
'--------------------------------------------------------------------------------------------------------------------------------
'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

'Définition des paramètres par défaut du groupe

ListOfsgroups.DefaultGroupIsActive = False
ListOfsgroups.DefaultGroupUpdateRate = 500 'millisecondes
ListOfsgroups.DefaultGroupDeadband = 1

'Ajout de ces groupes dans le serveur OPC

Set Group1 = ListOfsgroups.Add("Group1")

'Creation des Collections d'Items

Set PremierCollectionitems = Group1.OPCItems

'Définition des Items tout en respectant la syntaxe OPC et le pointeur coté client

ItemName1(1) = "automate0_cgms!Identifiant_cellule_du_cgms_2"
ItemName1(2) = "automate0_cgms!Identifiant_cellule_du_cgms_3"
ItemName1(3) = "automate0_cgms!Identifiant_cellule_du_cgms_4"
ItemName1(4) = "automate0_cgms!Identifiant_cellule_du_cgms_5"
ItemName1(5) = "automate0_cgms!Identifiant_cellule_du_cgms_6"
ItemName1(6) = "automate0_cgms!Identifiant_cellule_du_cgms_7"
ItemName1(7) = "automate0_cgms!Identifiant_cellule_du_cgms_8"
HandleClient1(1) = 1
HandleClient1(2) = 2
HandleClient1(3) = 3
HandleClient1(4) = 4
HandleClient1(5) = 5
HandleClient1(6) = 6
HandleClient1(7) = 7

End If

'Activation de lma Collection des Items

PremierCollectionitems.DefaultIsActive = True

'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????

1 réponse

Messages postés
6414
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
29 juillet 2020
334
Bonjour,

Essayes de le demander plus poliment la prochaine fois.

Nous sommes tous bénévoles ici, nous ne sommes pas tes employés. Alors quand tu veux quelque chose, demandes le gentiment au lieu de l'exiger.

Sujet clos