SyncWrite funktioniert nicht beim OPC Client

MPH

Well-known member
Beiträge
75
Punkte Reaktionen
1
Zuviel Werbung?
->Hier kostenlos registrieren
Hi Leute,

leider habe ich schon wieder ein Problem. Ich benutze den Excel OPC Client von der Siemens Seite:

Code:
Option Explicit
Option Base 0
' declaration of private OPC-objects within this modul
Private MyOPCServer As OPCServer
Private WithEvents MyOPCGroup As OPCGroup
' declaration of private OPC-variables
Private MyItemIDs() As String
Private MyServerHandles() As Long
Private MyNumItems As Long


'*****************************************************************
Public Sub cmdConnect_Click()
'** SERVER *************************************
On Error GoTo errorconnect
' create server object
Set MyOPCServer = New OPCServer
' connect server
Call MyOPCServer.Connect(Cells(4, 2))
'** GROUP **************************************
On Error GoTo errorgroup
' set fastest update rate for all groups
MyOPCServer.OPCGroups.DefaultGroupUpdateRate = 0
' create group
Set MyOPCGroup = MyOPCServer.OPCGroups.Add("name")
' disable all events of the group
MyOPCGroup.IsActive = False
MyOPCGroup.IsSubscribed = False
'** ITEMS *************************************************
On Error GoTo erroritems
MyNumItems = 165
ReDim MyItemIDs(MyNumItems)
ReDim MyClientHandles(MyNumItems) As Long
Dim i As Long
Dim Errors() As Long
' get the ItemIDs
For i = 1 To MyNumItems
MyItemIDs(i) = Cells(9 + i, 2)
MyClientHandles(i) = i
Next
' add items to the group
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


'**********Settings**********
' setting the buttons
cmdConnect.Enabled = False
cmdDisconnect.Enabled = True
cmdSyncRead.Enabled = True
cmdSyncWrite.Enabled = True
chkActivate.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


'**********************************************************************


Public Sub cmdDisconnect_Click()
On Error GoTo errorhandler
' remove the items
Dim Errors() As Long
Call MyOPCGroup.OPCItems.Remove(MyNumItems, MyServerHandles, Errors)
Erase Errors()
chkActivate.Value = 0
' remove the group
Call MyOPCServer.OPCGroups.RemoveAll
' free the object
Set MyOPCGroup = Nothing
' disconnect from server
Call MyOPCServer.Disconnect
' free the object
Set MyOPCServer = Nothing
' setting the buttons
cmdConnect.Enabled = True
cmdDisconnect.Enabled = False
cmdSyncRead.Enabled = False
cmdSyncWrite.Enabled = False
chkActivate.Enabled = False
Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)
End Sub


'*********************************************************
Public Sub cmdSyncRead_Click()
On Error GoTo errorhandler
Dim Values() As Variant
Dim Errors() As Long
Dim Qualities() As Integer
Dim TimeStamps() As Date
Dim i As Long
' read the values
Call MyOPCGroup.SyncRead(OPCDevice, MyNumItems, MyServerHandles, Values, Errors, Qualities, TimeStamps)
' fill values into the cells
For i = 1 To MyNumItems
If Errors(i) = 0 Then
Cells(9 + i, 3) = Values(i)
'Cells(9 + i, 4) = Qualities(i)
'Cells(9 + i, 5) = TimeStamps(i)
End If
Next
'free server allocated memory
Erase Values()
Erase Errors()
Erase Qualities()
Erase TimeStamps()
Exit Sub
errorhandler:
Call MsgBox(Err.Description, vbCritical)
End Sub


'*********************************************************


[B]Public Sub cmdSyncWrite_Click()[/B]
[B]On Error GoTo errorhandler[/B]
[B]Dim Values() As Variant[/B]
[B]Dim HServer() As Long[/B]
[B]Dim NumWriteItems As Long[/B]
[B]Dim Errors() As Long[/B]
[B]Dim i As Long[/B]
[B]Dim Frage As Long[/B]
[B]NumWriteItems = 0[/B]
[B]' fill values and serverhandles[/B]
[B]For i = 1 To MyNumItems[/B]
[B]' check for valid entry[/B]
[B]If Cells(9 + i, 6) <> "" Then[/B]
[B]ReDim Preserve Values(NumWriteItems + 1)[/B]
[B]ReDim Preserve HServer(NumWriteItems + 1)[/B]
[B]HServer(NumWriteItems + 1) = MyServerHandles(i)[/B]
[B]Values(NumWriteItems + 1) = Cells(9 + i, 6)[/B]
[B]NumWriteItems = NumWriteItems + 1[/B]
[B]End If[/B]
[B]Exit Sub[/B]
[B]End If[/B]

[B]Next[/B]
[B]' write only where valid values found[/B]
[B]Call MyOPCGroup.SyncWrite(NumWriteItems, HServer, Values, Errors)[/B]
[B]'free server allocated memory[/B]
[B]Erase Errors()[/B]
[B]Exit Sub[/B]
[B]errorhandler:[/B]
[B]Call MsgBox(Err.Description, vbCritical)[/B]
[B]End Sub[/B]


'*********************************************************


Public Sub chkActivate_Click()
If chkActivate.Value Then
' enable event (OnDataChange)
MyOPCGroup.IsActive = True
MyOPCGroup.IsSubscribed = True
Else
' disable all events of the group
MyOPCGroup.IsActive = False
MyOPCGroup.IsSubscribed = False
End If
End Sub


'*********************************************************


Public 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
' fill the values in the correct cells
For i = 1 To NumItems
Cells(9 + ClientHandles(i), 7) = ItemValues(i)


Next
End Sub

Eine Verbindung mit meiner S7cSteuerung habe ich. Ich kann auch die Werte von der Steuerung in Excel anzeigen.

Nun wollte ich mit SyncWrite (der fettgedruckte Teil) Werte in die SPS schreiben. Also sozusagen einen Eingang auf Bool setzen, indem ich in der dafür vorgesehenen Zelle True oder Wahr reinschreibe.
Leider funktioniert das nicht. Die Werte im Data Change und auf der S7 Steuerung verändern sich nicht. Ich bekomme aber auch keine Fehlermeldung!!!

Ist da irgendwo ein Fehler drin????

Noch eine andere Frage. Wie fügt ihr den Code immer in diesen grauen Kästchen ein???

Hoffe ihr könnt mir helfen.

Vielen Dank schonmal

Gruß
 
Zuletzt bearbeitet von einem Moderator:
OP
M

MPH

Well-known member
Beiträge
75
Punkte Reaktionen
1
Hi Leute,

irgendwie komme ich immer selbst zur Lösung sobald ich es ins Forum schreibe. Scheint die positive Energy zu sein hahahah :ROFLMAO:.
Egal ich habe es rausbekommen.
Falls es jemanden interessiert, der Fehler lag in der Bezeichnung der Items und ich muss statt WAHR true schreiben.

Aber trotzdem könntet ihr mir noch veraten, wie des mit dem Code einfügen geht, das es in diesem grauen Kästchen angezeigt wird.
Damit ich das in Zukunft machen kann.

Vielen Dank

Grüße
 

MKa

New member
Beiträge
1
Punkte Reaktionen
0
Hallo zusammen,

ich habe so ziemlich dasselbe Problem. Im Siemens Support findet man ein ähnliches Code-Beispiel, in dem ebenfalls die SyncWrite-Routine zwar ohne Fehler ausgeführt wird, jedoch keine Veränderung der PLC-Variablen der angesteuerten S7-1200-CPU bewirkt. Beim debuggen und beobachten habe ich gesehen, dass der Funktion die korrekten Arrays mit den richtigen Werten (insbesondere Values)übergeben wird.

Hier ist mein Code-Beispiel:

'Subroutine bei clickEvent auf den Button Write - Bewirkt, dass die in den Zellen 11F bis 18F stehenden Werte​
'in die CPU geschrieben werden (um eine Auswertung von Eingabefehlern bei der Zeit zu vermeiden, wird auf die Eingabe​
'eines Zeitwertes verzichtet​
Private Sub cmd_Write_Click()​
'Variablen für die Parameter der Übertragung​
Dim SHandles(N - 1) As Long 'parameter value​
Dim Values(N - 1) As Variant 'parameter value​
Dim Errors() As Long 'return value​
Dim i As Integer​
'save ServerHandles (Benötigt für Einlesen in CPU). Für jede Variable eine!​
For i = 1 To (N - 1)​
SHandles(i) = MyOPCItems(i).ServerHandle​
Next i​
'Lese Werte aus den Zellen 11F bis 18F in das Array Values ein​
For i = 1 To (N - 1)​
Values(i) = Cells(10 + i, 6)​
If Values(i) = "" Then Values(i) = 0​
Next i​
'Anweisung zum Schreiben der Werte in die CPU​
Call MyOPCGroup.SyncWrite(N - 1, SHandles, Values, Errors)​
End Sub​

N ist die Anzahl der einzulesenen Items, wobei nur N-1 Items eingelesen werden sollten.


Wäre großartig, wenn ihr mir helfen könnt, damit das einlesen auch endlich klappt! Vielen Dank im Voraus!

Gruß MKa
 
Oben