Sub OnLButtonUp(Byval Item, Byval Flags, Byval x, Byval y)
Dim a, wshshell, key, b
Dim objExcelApp
Dim objWorkbooks
Dim objSheet
Dim objTag_intern, objTag_extern, Zaehler, Zaehler_Trag, Zeichen
Dim MotorGenerator, GeneratorMotor
Dim Uebersetz_G1, Uebersetz_G2
Dim sIniDir, sFilter, sTitle, oDlg, GetFileDlgEx, wsExcel
Dim rep, appExcel
'On Error Resume Next
Set objTag_extern = HMIRuntime.Tags("Digi_S7_WinCC1")
If (objTag_extern.read And &H40040000) = &H40040000 Then
motorgenerator = 1
generatormotor = 0
Elseif (objTag_extern.read And &H80020000) = &H80020000 Then
motorgenerator = 0
generatormotor = 1
Else MsgBox "Keine Betriebsart für Maschine 1 und Maschine 2 angegeben"
Exit Sub
End If
Set objTag_extern = HMIRuntime.Tags("Übersetz_G1")
If objTag_extern.Read = 0 Then
MsgBox "Kein Übersetzungsverhältnis für G1 angegeben"
Exit Sub
Else Uebersetz_G1 = objTag_extern.Read
End If
Set objTag_extern = HMIRuntime.Tags("Übersetz_G2")
If objTag_extern.Read = 0 Then
MsgBox "Kein Übersetzungsverhältnis für G2 angegeben"
Exit Sub
Else Uebersetz_G2 = objTag_extern.Read
End If
'Prüfablaufunterbrechungen auf Null setzen
Set objTag_extern = HMIRuntime.Tags("Trag_DWORD_1")
objTag_extern.Write 0
Set objTag_extern = HMIRuntime.Tags("Trag_DWORD_2")
objTag_extern.Write 0
Set objTag_extern = HMIRuntime.Tags("Trag_DWORD_3")
objTag_extern.Write 0
Set objTag_extern = HMIRuntime.Tags("Trag_DWORD_4")
objTag_extern.Write 0
sIniDir = ("D:\\Belastungsvorgaben\\*")
sFilter = ("Excel (*.xlsx)|*.xlsx|")
sTitle = ("Auswahl der Benötigten Excel-Datei")
Set oDlg = CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);eval(new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0).Read("&Len(sIniDir)+Len(sFilter)+Len(sTitle)+41&"));function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg(iniDir,null,filter,title)));close();}</script><hta:application showintaskbar=no />""")
oDlg.StdIn.Write "var iniDir='" & sIniDir & "';var filter='" & sFilter & "';var title='" & sTitle & "';" 'öffnet den dialog
GetFileDlgEx = oDlg.StdOut.ReadAll
Set objExcelApp = CreateObject("Excel.Application")
Set objWorkbooks = objExcelApp.Workbooks.Open (GetFileDlgEx)
Set wsExcel = objWorkbooks.Worksheets("Tabelle1")
'Laufzeiten einlesen
For Zaehler = 1 To 120
wsExcel.Range("B" & Zaehler + 4).Select
Set objTag_extern = HMIRuntime.Tags("PS" & Zaehler & "t")
If .ActiveCell.Value = "" Then
objTag_extern.Write 0
Elseif .ActiveCell.Value = 0 Or (.ActiveCell.Value > 9 And .ActiveCell.Value < 9000) Then objTag_extern.Write .ActiveCell.Value
Else
MsgBox "Das Einlesen wird gestoppt ab Zelle C" & Zaehler + 4
Zaehler = 120
objExcelApp.Workbooks.Close
' Tabelle schließen
objExcelApp.Quit
' Excel schließen
Set objExcelApp = Nothing
Exit Sub
End If
Next
'Solldrehzahl Abtrieb einlesen
For Zaehler = 1 To 120
wsExcel.Range("C" & Zaehler + 4).Select
Set objTag_intern = HMIRuntime.Tags("P" & Zaehler & "n")
Set objTag_extern = HMIRuntime.Tags("PS" & Zaehler & "n")
If .ActiveCell.Value = "" Then
objTag_intern.Write 0
objTag_extern.Write 0
Elseif .ActiveCell.Value = 0 Or (.ActiveCell.Value > 9 And .ActiveCell.Value < 5400) Then
objTag_intern.Write .ActiveCell.Value
If Motorgenerator = 1 Then
objTag_extern.Write .ActiveCell.Value * Uebersetz_G1 / Uebersetz_G2
Elseif generatormotor = 1 Then
objTag_extern.Write .ActiveCell.Value * Uebersetz_G2 / Uebersetz_G1
Else objTag_extern.Write 0
End If
Else
MsgBox "Das Einlesen wird gestoppt ab Zelle A" & Zaehler + 4
Zaehler = 120
objExcelApp.Workbooks.Close
' Tabelle schließen
objExcelApp.Quit
' Excel schließen
Set objExcelApp = Nothing
Exit Sub
End If
Next
'Solldrehmoment Abtrieb einlesen
For Zaehler = 1 To 120
wsExcel.Range("D" & Zaehler + 4).Select
Set objTag_extern = HMIRuntime.Tags("PS" & Zaehler & "M")
If .ActiveCell.Value = "" Then
objTag_extern.Write 0
Elseif .ActiveCell.Value = 0 Or (.ActiveCell.Value > 9 And .ActiveCell.Value < 40000) Then
objTag_extern.Write .ActiveCell.Value
Else
MsgBox "Das Einlesen wird gestoppt ab Zelle B" & Zaehler + 4
Zaehler = 120
objExcelApp.Workbooks.Close
' Tabelle schließen
objExcelApp.Quit
' Excel schließen
Set objExcelApp = Nothing
Exit Sub
End If
Next
'Prüfablaufunterbrechungen für Tragbildaufnahmen (T) einlesen
For Zaehler = 1 To 119
wsExcel.Range("E" & Zaehler + 4).Select
Set objTag_extern = HMIRuntime.Tags("Trag_" & Zaehler)
For Zaehler_Trag = 1 To Len(.ActiveCell.Value)
Zeichen = Mid(.ActiveCell.Value, Zaehler_Trag, 1)
If Zeichen = "T" And wsExcel.cells((Zaehler+4),3).value > 0 Then
objTag_extern.Write 1
End If
Next
Next
objExcelApp.Workbooks.Close
' Tabelle schließen
objExcelApp.Quit
' Excel schließen
Set objExcelApp = Nothing
MsgBox "Einlesen der Excel-Datei erfolgreich beendet",vbSystemModal
End Sub