Option Explicit
Option Base 1
' Private OPC Objekte deklarieren
Private MyOPCServer As OPCServer
Private WithEvents MyOPCGroup As OPCGroup
' Provate OPC Variablen deklarieren
Private MyItemIDs() As String
Private MyServerHandles() As Long
Private MyNumItems As Long
Private Sub cmdConnect_Click() 'Verbinden
'** Server generieren *************************************
On Error GoTo errorconnect
' create server object
Set MyOPCServer = New OPCServer
' Servername:
Call MyOPCServer.Connect(Cells(35, 4))
'** Gruppe generieren ************************************
On Error GoTo errorgroup
' schnellstes Update für alle Gruppen auswählen
MyOPCServer.OPCGroups.DefaultGroupUpdateRate = 0
' Gruppe:
Set MyOPCGroup = MyOPCServer.OPCGroups.Add(Cells(36, 4))
' Alle Aktionen der Gruppe deaktivieren
MyOPCGroup.IsActive = False
MyOPCGroup.IsSubscribed = False
'** Variabeln auswählen ***********************************
On Error GoTo erroritems
MyNumItems = 16 'Anzahl Variablen
ReDim MyItemIDs(MyNumItems)
ReDim MyClientHandles(MyNumItems) As Long
Dim i As Long
Dim Errors() As Long
' 1. Variable
For i = 1 To MyNumItems
MyItemIDs(i) = Cells(17 + i, 3)
MyClientHandles(i) = i
Next
' Variabeln zur Gruppe hinzufügen
Call MyOPCGroup.OPCItems.AddItems(MyNumItems, MyItemIDs, MyClientHandles, MyServerHandles, Errors)
For i = 1 To MyNumItems
If Errors(i) <> 0 Then
Call MsgBox(MyItemIDs(i) & Chr(13) & MyOPCServer.GetErrorString(Errors(i)), vbCritical)
End If
Next
'** Optionen ******************************************
' Button - Optionen
cmdConnect.Enabled = False
cmdDisconnect.Enabled = True
cmdSyncRead.Enabled = True
cmdSyncWrite.Enabled = True
Exit Sub
errorconnect:
Call MsgBox("Error Connect:" & Chr(13) & Err.Description, vbCritical)
Exit Sub
errorgroup:
Call MsgBox("Error AddGroup:" & Chr(13) & Err.Description, vbCritical)
Exit Sub
erroritems:
Call MsgBox("Error AddItems:" & Chr(13) & Err.Description, vbCritical)
End Sub
Private Sub cmdDisconnect_Click() 'trennen
On Error GoTo errorhandler
' alle Variabeln zurücksetzen
Dim Errors() As Long
Call MyOPCGroup.OPCItems.Remove(MyNumItems, MyServerHandles, Errors)
Erase Errors()
' Gruppe zurücksetzen
Call MyOPCServer.OPCGroups.RemoveAll
Set MyOPCGroup = Nothing
' Server trennen
Call MyOPCServer.Disconnect
Set MyOPCServer = Nothing
' Buttons sperren / entsperren
cmdConnect.Enabled = True
cmdDisconnect.Enabled = False
cmdSyncRead.Enabled = False
cmdSyncWrite.Enabled = False
Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)
Cells(18, 1) = 1
End Sub
Private Sub cmdSyncRead_Click() 'lesen
'Zeitschlaufe - Loop
Dim xy1, x As Integer
xy1 = Range("K15").Value
For x = 1 To xy1 'das bedeutet das wenn x den Wert xy1+1 annimmt wird die for schleife nicht mehr durchlaufen
Range("A1").Select
Calculate
On Error GoTo errorhandler
Dim Values() As Variant
Dim Errors() As Long
Dim Qualities() As Integer
Dim TimeStamps() As Date
Dim i As Long
' Werte lesen
Call MyOPCGroup.SyncRead(OPCDevice, MyNumItems, MyServerHandles, Values, Errors, Qualities, TimeStamps)
' Werte schreiben (aus Sollwerten)
For i = 1 To MyNumItems
If Errors(i) = 0 Then
Cells(17 + i, 5) = Values(i)
Cells(17 + i, 6) = Qualities(i)
Cells(17 + i, 7) = TimeStamps(i)
End If
Next
Erase Values()
Erase Errors()
Erase Qualities()
Erase TimeStamps()
'Schleife für 1 Sekunde unterbrechen
Application.Wait (Now + TimeValue("0:00:00")) '("0:00:01")
' Ende der Schlaufe wenn "E21" erfüllt ist oder wenn der Wert "K15" erfüllt ist
If Range("E21").Value = 0 Then
GoTo 2:
End If
Next x
2:
Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)
End Sub
Private Sub cmdSyncWrite_Click() 'schreiben
On Error GoTo errorhandler
Dim Values() As Variant
Dim HServer() As Long
Dim NumWriteItems As Long
Dim Errors() As Long
Dim i As Long
NumWriteItems = 0
' Schreibe Ist Werte
For i = 1 To MyNumItems
If Cells(17 + i, 9) <> "" Then
ReDim Preserve Values(NumWriteItems + 1)
ReDim Preserve HServer(NumWriteItems + 1)
HServer(NumWriteItems + 1) = MyServerHandles(i)
Values(NumWriteItems + 1) = Cells(17 + i, 9)
NumWriteItems = NumWriteItems + 1
End If
Next
Call MyOPCGroup.SyncWrite(NumWriteItems, HServer, Values, Errors)
Erase Errors()
Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)
End Sub
Private Sub CommandButton1_Click()
cmdConnect.Enabled = True
End Sub
Private Sub MyOPCGroup_DataChange(ByVal TransactionID As _
Long, ByVal NumItems As Long, ClientHandles() As Long, _
ItemValues() As Variant, Qualities() As Long, _
TimeStamps() As Date)
Dim i As Integer
Application.OnTime Now + TimeSerial(0, 0, 3), "deinMakro"
' Schreibe Ist Werte in Zellen
For i = 1 To NumItems
Cells(18 + ClientHandles(i), 9) = ItemValues(i)
Next
End Sub
Private Sub Workbook_Open()
'Call deinMakro
End Sub