Welcome to our new forum
All users of the legacy CODESYS Forums, please create a new account at account.codesys.com. But make sure to use the same E-Mail address as in the old Forum. Then your posts will be matched. Close

opc client excel2007 unter windows7

rule
2012-03-06
2012-03-07
  • rule - 2012-03-06

    Hallo erstmal,

    habe ein Problem, das wir folgt aussieht:

    ich habe eine client anbindung in excel 2007 mit vba geschrieben. betriebssystem ist windows 7.
    ich will daten von der sps auslesen und auch aus excel vorgeben können. der code um die verbindung herzustellen sieht wie folgt aus :

    Option Explicit
    Option Base 1

    'Deklaration der privaten OPC Objekte innerhalb dieses Moduls

    Private MyOPCServer As OPCServer
    Private WithEvents MyOPCGroup As OPCGroup

    'Deklaration der privaten OPV Variablen

    Private MyItemIDs() As String
    Private MyServerHandles() As Long
    Private MyNumItems As Long

    '************
    Private Sub cmdConnect_Click()

    'Server*****
    On Error GoTo errorconnect

    'erstellen des Objekts im Server
    Set MyOPCServer = New OPCServer

    'Server verbinden
    Call MyOPCServer.Connect(Cells(4, 2), Cells(5, 2))

    'Gruppen*******
    On Error GoTo errorgroup

    'schnellste Updaterate für alle Gruppen setzen
    MyOPCServer.OPCGroups.DefaultGroupUpdateRate = 0

    'Gruppe erstellen
    Set MyOPCGroup = MyOPCServer.OPCGroups.Add(Cells(7, 2))

    'deaktiviere alle Ereignisse der Gruppe
    MyOPCGroup.IsActive = False
    MyOPCGroup.IsSubscribed = False

    'Items******
    On Error GoTo erroritems
    MyNumItems = 1
    ReDim MyItemIDs(MyNumItems)
    ReDim MyClientHandles(MyNumItems) As Long
    Dim i As Long
    Dim Errors() As Long

    'einlesen der ItemIDs
    For i = 1 To MyNumItems
    MyItemIDs(i) = Cells(9 + i, 2)
    MyClientHandles(i) = i
    Next

    'füge Items der Gruppe zu
    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

    'Einstellungen******

    'Zuweisungen der Tasten
    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

    Private Sub cmdConnect_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    End Sub

    Private Sub cmdConnect_Error(ByVal Number As Integer, ByVal Description As MSForms.ReturnString, ByVal SCode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, ByVal CancelDisplay As MSForms.ReturnBoolean)

    End Sub

    '**Server trennen*****
    Private Sub cmdDisconnect_Click()

    On Error GoTo errorhandler

    'entfernen der Items
    Dim Errors() As Long
    Call MyOPCGroup.OPCItems.Remove(MyNumItems, MyServerHandles, Errors)
    Erase Errors()
    chkActivate.Value = 0

    'entfernen der Gruppe
    Call MyOPCServer.OPCGroups.RemoveAll

    'Merkmale (Objekte) freigeben
    Set MyOPCGroup = Nothing

    'Vom Server trennen
    Call MyOPCServer.Disconnect

    'Merkmal freigeben
    Set MyOPCServer = Nothing

    'Lösen der Tasten
    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

    '*Synchron lesen****
    Private 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

    'Werte lesen

    Call MyOPCGroup.SyncRead(OPCDevice, MyNumItems, MyServerHandles, Values, Errors, Qualities, TimeStamps)

    'Werte in Zellen schreiben

    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

    'Server von zugewiesenem Speicher bereinigen

    Erase Values()
    Erase Errors()
    Erase Qualities()
    Erase TimeStamps()
    Exit Sub

    errorhandler:
    Call MsgBox(Err.Description, vbCritical)

    End Sub

    '*Synchrones Schreiben****

    Private Sub cmdSyncWrite_Click()

    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
    
    'Werte und serverhandles füllen
    For i = 1 To MyNumItems
    
    'auf gültige Eingaben prüfen
        If Cells(9 + i, 6) <> "" Then
            ReDim Preserve Values(NumWriteItems + 1)
            ReDim Preserve HServer(NumWriteItems + 1)
            HServer(NumWriteItems + 1) = MyServerHandles(i)
            Values(NumWriteItems + 1) = Cells(9 + i, 6)
            NumWriteItems = NumWriteItems + 1
        End If
    Next
    
    'schreibe nur dort wo gültige Werte gefunden wurden
    Call MyOPCGroup.SyncWrite(NumWriteItems, HServer, Values, Errors)
    
    Erase Errors()
    

    Exit Sub

    errorhandler:
    Call MsgBox(Err.Description, vbCritical)
    End Sub

    'Aktivierung der Gruppen*******

    Private Sub chkActive_Click()

    If chkActivate.Value Then
    
        'Vorgang gestatten (OnDataChange)
    
        MyOPCGroup.IsActive = True
        MyOPCGroup.IsSubscribed = True
    Else
        'alle Vorgänge dieser Gruppe deaktivieren
        MyOPCGroup.IsActive = False
        MyOPCGroup.IsSubscribed = False
    End If
    

    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

    ' fill the values in the correct cells
    For i = 1 To NumItems
        Cells(9 + ClientHandles(i), 7) = ItemValues(i)
    Next
    

    End Sub

    bekomme als fehlermeldung immer wieder die probleme mit der blockvariable oder den activex elementen. weiß so langsam nicht mehr weiter. kann es am betriebssystem hängen oder ist der code einfach schrott?
    vielen dank schonmal für die hilfe!!!!!!

    gruß

     
  • Rolf-Geisler - 2012-03-06

    Hi,
    ist ziemlich viel zu lesen in Deinem Post, überblicke nicht alles auf die Schnelle.
    http://www.opcconnect.com/tooltech.php.
    Gruss Rolf

     
  • rule - 2012-03-07

    ja ist alles in vba im entsprechenden excel projekt programmiert. habe es auf einem zweitrechner, der frisch aufgesetzt ist getestet und dort lief es. auf meinem "arbeitslaptop" geht das exakt gleiche programm wiederum nicht.... zum verzweifeln

     

Log in to post a comment.