Option Explicit
' Definition der Container mit Onlinevariablen für
' jeden Zugriff auf Runtimevariablen aus dem VBA-Skript heraus.
Public WithEvents Container As OnlineVariable
Public PDE_Container As OnlineVariable
Public Sub Profinet_Init()
'##### PROFINET-DIAGNOSE INITIALISIEREN #####
Dim i As Integer
Dim Profinet As Variable
For i = 1 To 256
PN_Container.Add "Profinet_Station[" & i & "]"
Next i
PN_Container.Add "Profinet_Device_aktiv"
PN_Container.Define
'interne Variablen für Profinet-Devicenummer initialisieren
For i = 1 To 256
Set Profinet = thisProject.Variables.Item("Profinet_Station[" & i & "]")
Profinet.Value = i
Next i
thisProject.RtFunctions.Item("fct_Profinet_Systemnummer_setzen").start
'Vorbereitung zum Anklicken einer PROFINET-Station
PN_Container.Undefine
PN_Container.Add "Profinet_Device_aktiv"
PN_Container.Define
End Sub
Public Sub Profinet_Detailfenster_verschieben()
'##### PROFINET-DETAILFENSTER VERSCHIEBEN #####
Dim meinBild As DynPicture
Set meinBild = thisProject.DynPictures.Item("Profinet_Details")
' Positionskorrektur in x-Richtung
If xkoord > (1280 - meinBild.Width) Then ' Falls der rechte Rand erreicht ist, das Bild an die linke Seite anheften
xkoord = xkoord - meinBild.Width - breite ' x-Koordinate um Breite des Detailfensters und des Stationssymbols verschieben
End If
' Positionskorrektur in y-Richtung (124 steht für die Höhe der Kopfzeile)
If (ykoord + 124) > (1024 - meinBild.Height) Then ' Falls der untere Rand erreicht ist, das Bild entsprechne nach oben schieben
ykoord = ykoord - ((thisProject.ykoord + 124) - (1024 - meinBild.Height)) ' Differenz abziehen, um Bild höher schieben
End If
' Bild an neue Position verschieben
' wird normalerweise direkt neben rechtem Eck des Symbols geöffnet
' (Der Wert 124 ist die Höhe der Kopfzeile)
meinBild.Move xkoord, ykoord + 124, meinBild.Width, meinBild.Height
End Sub
Private Sub Project_Active()
'##### STARTRUTINE DER RUNTIME #####
Set PN_Container = thisProject.OnlineVariables.CreateOnlineVariables("profinet")
Set STG_Container = thisProject.OnlineVariables.CreateOnlineVariables("stellgeraete")
Set Ident_Container = thisProject.OnlineVariables.CreateOnlineVariables("ident")
Set Typ_Container = thisProject.OnlineVariables.CreateOnlineVariables("typverwaltung")
Set Schrauber_Container = thisProject.OnlineVariables.CreateOnlineVariables("schrauberkrempl")
'Container mit den Variablen für die Rueckverfolgung
Set PDE_Container = thisProject.OnlineVariables.CreateOnlineVariables("PDE")
PDE_Container.Add "PDE_PraegeCode"
PDE_Container.Add "PDE_OrdnerName"
PDE_Container.Add "PDE_OrdnerErstellen"
PDE_Container.Add "PDE_Bolzen10R01"
PDE_Container.Add "PDE_MS15R01"
PDE_Container.Add "PDE_Kamera15R01"
PDE_Container.Add "PDE_Kelchung15R01"
PDE_Container.Add "PDE_Bolzen15R02"
PDE_Container.Add "PDE_Intec15R02"
PDE_Container.Add "PDE_HWH30R01"
PDE_Container.Add "PDE_HWH30R02"
PDE_Container.Add "PDE_HWH40R01"
PDE_Container.Add "PDE_HWH50R01"
PDE_Container.Add "PDE_HWH60R01"
PDE_Container.Add "PDE_HWH60R02"
PDE_Container.Define
End Sub
Private Sub Project_Inactive()
'##### ENDERUTINE DER RUNTIME #####
On Error Resume Next
Container.Undefine ' Online Container wieder löschen
Debug.Print "Der Container ist undefined"
PDE_Container.Undefine
thisProject.OnlineVariables.DeleteOnlineVariables ("PDE")
End Sub
'Dateien vom Bolzen kopieren 10R01
Public Sub Bolzen_10R01()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Fehlerroutine: Datei nicht vorhanden
If oFSO.FileExists("\\TOX10R01\AppData\" & strDatei & "TOX10R01.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_10R01BolNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\TOX10R01\AppData\" & strDatei & "TOX10R01.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_Bolzen10R01").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien von der Kelchung kopieren 15R01
Public Sub Kelchung_15R01()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\TOX15R01\AppData\" & strDatei & "TOX15R01.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_15R01KelNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\TOX15R01\AppData\" & strDatei & "TOX15R01.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_Kelchung15R01").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Bolzen kopieren 15R02
Public Sub Bolzen_15R02()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
If oFSO.FileExists("\\TOX15R02\AppData\" & strDatei & "TOX15R02.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_15R02BolNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\TOX15R02\AppData\" & strDatei & "TOX15R02.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_Bolzen15R02").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Kleben kopieren 15R02
Public Sub Intec_15R02()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\INT15R02\AppData\" & strDatei & "INT15R02.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_15R02IntNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\INT15R02\AppData\" & strDatei & "INT15R02.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_Intec15R02").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Schweißen kopieren 30R01
Public Sub HWH_30R01()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH30R01.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_30R01HwHNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH30R01.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_HWH30R01").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Schweißen kopieren 30R02
Public Sub HWH_30R02()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH30R02.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_30R02HwHNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH30R02.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_HWH30R02").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Schweißen kopieren 40R01
Public Sub HWH_40R01()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH40R01.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_40R01HwHNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH40R01.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_HWH40R01").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Schweißen kopieren 40R02
Public Sub HWH_40R02()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH40R02.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_40R02HwHNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH40R02.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_HWH40R02").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Schweißen kopieren 50R01
Public Sub HWH_50R01()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH50R01.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_50R01HwHNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH50R01.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_HWH50R01").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Schrauber kopieren 60R01
Public Sub Schrauber_60R01()
Dim strNr As Variant
Dim strOrdner As String
Dim oFSO As Object
strNr = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNr), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Fehlerroutine: Datei nicht vorhanden
If oFSO.FileExists("D:\S7_Export\Schrauber\????\*.*", "D:\S7_Export\AppData\" & strOrdner & "\") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_60R01RexNoFile").Value = 1
Else
'File exist
oFSO.MoveFile "D:\S7_Export\Schrauber\????\*.*", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_Schrauber60R01").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Schweißen kopieren 60R01
Public Sub HWH_60R01()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH60R01.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_60R01HwHNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH60R01.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_HWH60R01").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub
'Dateien vom Schweißen kopieren 60R02
Public Sub HWH_60R02()
Dim strNrO As Variant
Dim strNrD As Variant
Dim strOrdner As String
Dim strDatei As String
Dim oFSO As Object
strNrO = thisProject.Variables.Item("PDE_OrdnerName").Value
strNrD = thisProject.Variables.Item("PDE_PraegeCode").Value
strOrdner = Format(CStr(strNrO), "00000000000")
strDatei = Format(CStr(strNrD), "00000000000")
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH60R02.txt") = False Then
'File doesn't exist
thisProject.Variables.Item("PDE_60R02HwHNoFile").Value = 1
Else
'File exist
oFSO.CopyFile "\\PEGASUS\AppData\" & strOrdner & "\" & strDatei & "HWH60R02.txt", "D:\S7_Export\AppData\" & strOrdner & "\"
End If
thisProject.Variables.Item("PDE_HWH60R02").Value = 0 'Tiggersignal auf 0 setzen
Set oFSO = Nothing
End Sub