Option Private Module
Option Explicit
Type UDT_SPS_Adresse
MPI_Nr As Byte
Segment_ID As Byte
Steckplatz_Nr As Byte
Rack_Nr As Byte
End Type
' Prodave Funktionen deklarieren
Declare Function load_tool Lib "w95_s7.dll" (ByVal Nr As Byte, ByVal dev As String, adr As UDT_SPS_Adresse) As Long
Declare Function d_field_read Lib "w95_s7.dll" (ByVal B_dbno As Long, ByVal B_dwno As Long, ByVal B_amount As Long, buffer As Byte) As Long
Declare Function unload_tool Lib "w95_s7.dll" () As Long
Declare Sub gp_to_float Lib "komfort.dll" (gp As Byte, s As Single)
Declare Function testbit Lib "komfort.dll" (ByVal Bytewert As Byte, ByVal Bit_Nr As Integer) As Boolean
Sub Daten_von_SPS_via_MPI_lesen()
' ******************************************************************************
' Daten aus der SPS lesen und als Aktualwerte in Register schreiben (7.7.2003)
' 1. Prüfen ob es sich beim Register um einen DB handelt.
' 2. Prüfen ob die DB-Nr.vorhanden ist.
' 3. Erste und Letzte Zeile bestimmen.
' 4. Prüfen ob ungültige absolute Adressen vorhanden sind.
' 5. Länge in Byte des gesammten DBs bestimmen
' 6. Abfrage der MPI und Steckplatz Nummer
' 7. Daten aus SPS lesen und in Array speichern
' 8. Schleife über alle Zeilen
' 8.1 Datentyp ermitteln
' 8.2 Daten umwandeln
' 8.3 Anfangswert mit Aktualwert vergleichen
' 8.4 Farbe bestimmen
' 8.5 Schlüsselwort bestimmen
' 8.6 Wert in Zelle schreiben
' 9. Meldung, wenn alle Aktualwerte gleich sind wie die Anfangswerte
' ******************************************************************************
Dim DB_Nr As Integer
Dim DBB_Nr As Long
Dim Anzahl_Byte As Long
Dim Byte_Adr As Long
Dim Bit_Adr As Integer
Dim SPS_Adresse(1) As UDT_SPS_Adresse
Dim Puffer() As Byte
' Auswahldialog für die MPI-Schnittstelle
frmMPI_Daten.Show
' Prüfen ob der Dialog abgebrochen wurde
If frmMPI_Daten.ComboBox_Steckplatz.Value = "" Then
' Dialog wird aus dem Speicher wieder gelöscht
Unload frmMPI_Daten
Exit Sub
End If
' Parameter für aktuelle Schnittstelle zur SPS
SPS_Adresse(0).MPI_Nr = frmMPI_Daten.ComboBox_MPI_Nr.Value
SPS_Adresse(0).Segment_ID = 0
SPS_Adresse(0).Steckplatz_Nr = frmMPI_Daten.ComboBox_Steckplatz.Value
SPS_Adresse(0).Rack_Nr = 0
SPS_Adresse(1).MPI_Nr = 0
' Auswahldialog MPI-Schnittstelle wird aus dem Speicher gelöscht
Unload frmMPI_Daten
' Schnittstelle zur SPS öffnen und ev.Fehler ausgeben
On Error GoTo MPI_Fehler:
If Not AG_Error(load_tool(1, "S7ONLINE", SPS_Adresse(0))) Then
On Error GoTo 0
Application.StatusBar = "Daten werden aus der SPS gelesen!"
' Datenbaustein-Nr. und Anzahl Byte bestimmen, die aus der SPS gelesen werden
DB_Nr = Bausteindaten_lesen(Col_BausteinNr)
DBB_Nr = 0
Anzahl_Byte = Byte_Nr_aus_Adresse(ActiveSheet.Cells(Zeile_Ende + 1, Col_Adresse))
' Das Array wird vor dem lesen aus der SPS angepasst
ReDim Puffer(Anzahl_Byte - 1)
' Datenbaustein wird byteweise aus SPS lesen und ev.Fehler ausgeben
On Error GoTo DB_Nr_Fehler:
If Not AG_Error(d_field_read(DB_Nr, DBB_Nr, Anzahl_Byte, Puffer(0))) Then
On Error GoTo 0
Application.StatusBar = "Schnittstelle zur SPS wird geschlossen!"
' Schnittstelle zur SPS wieder schliessen und ev.Fehler ausgeben
AG_Error (unload_tool())
Application.StatusBar = "Daten wurde aus der SPS gelesen!"
Exit Sub
' Fehlerroutinen
' --------------
MPI_Fehler:
' Fehlermeldung Prodave ist nicht installiert
MsgBox "Aktualwerte können nur aus der SPS gelesen werden, wenn" & Chr(13) & _
"der Siemens Treiber ""Prodave"" oder ""Prodave-Mini"" installiert ist!", vbCritical, "MPI Kommunikationsfehler"
Exit Sub
DB_Nr_Fehler:
' Fehlermeldung DB-Nr ungültig
MsgBox "DB-Nr. konnte nicht gelesen werden", vbCritical, "MPI Kommunikationsfehler"
' Schnittstelle zur SPS wieder schliessen und ev.Fehler ausgeben
AG_Error (unload_tool())
End Sub
Function AG_Error(e_Error_Code As Integer) As Boolean
'***************************************************************
' Prüfen ob bei der Kommunikation mit der SPS-Schnittstelle
' über MPI ein Fehler aufgetretten ist.
' Es werden nur die Fehlermeldungen im Klartext ausgegeben,
' welche beim lesen eines DBs auftretten können.
' -> Fehlerauswertung noch nicht fertig (30.06.2003)
'***************************************************************
Dim Fehlertext As String
' Prüfen ob ein Fehler aufgetretten ist
If e_Error_Code = 0 Then
AG_Error = False
Else
AG_Error = True
Select Case Hex(e_Error_Code)
Case "203"
Fehlertext = "PRODAVE schon initialisiert!" & Chr(13) & _
"-> PC/PG neu starten"
Case "303"
Fehlertext = "Bausteingrenze überschritten, Anzahl korrigieren!" & Chr(13) & _
"Zu viele Daten wurden versucht aus der SPS zu lesen"
Case "336"
Fehlertext = "keine Verbindung"
Case "4002"
Fehlertext = "Verbindung zur SPS konnte nicht aufgebaut werden"
Case Else
Fehlertext = "Allgemeiner Kommunikationsfehler" & Chr(13) & Chr(13) & _
"Fehlercode mit Beschreibung bitte an ""glarnerm@solnet.ch"""
End Select
' Fehlermeldung ausgeben
MsgBox "Fehlercode: Hex " & Hex(e_Error_Code) & Chr(13) & Chr(13) & _
Fehlertext, vbCritical, "MPI Kommunikationsfehler"
End If
End Function