das wusste ich nicht das sich dann alle zugriffe von .irgendwas auf das aktuelle workbook beziehen.die nicht an ein Objekt binden. zb soCode:with objWorkbooks
ansonsten hätte der te vor allen aufrufen mit .irgendwas das wsExcel voranstellen müssen.
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
'Laufzeiten einlesen
For Zaehler = 1 To 120
wsExcel.Range("B" & Zaehler + 4).Select
Set objTag_extern = HMIRuntime.Tags("PS" & Zaehler & "t")
If [COLOR=#FF0000].ActiveCell.[/COLOR]Value = [COLOR=#FF0000][/COLOR]"" Then
objTag_extern.Write 0
Elseif [COLOR=#FF0000].ActiveCell[/COLOR].Value = 0 Or [COLOR=#FF0000](.ActiveCell[/COLOR].Value > 9 And [COLOR=#FF0000].ActiveCell[/COLOR].Value < 9000) Then objTag_extern.Write [COLOR=#FF0000].ActiveCell[/COLOR].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
'Laufzeiten einlesen
[COLOR=#0000FF]with wsExcel[/COLOR]
For Zaehler = 1 To 120
l.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
[COLOR=#0000FF]end with[/COLOR]
das hat Larry doch im post 22schon gesagt wie das zusammenhängtHallo nochmal,
nur mal interessehalber, wie muesste das Script den Aussehen, wenn man mit WITH arbeiten moechte bzw. mit dem Hauptobjekt?
Laesst mich einfach nicht los.
Set objExcelApp = CreateObject("Excel.Application")
Set objWorkbooks = objExcelApp.Workbooks.Open (GetFileDlgEx)
[COLOR=#FF0000]With objExcelApp[/COLOR]
'Laufzeiten einlesen
For Zaehler = 1 To 120
[COLOR=#FF0000].Range[/COLOR]("B" & Zaehler + 4).Select
Set objTag_extern = HMIRuntime.Tags("PS" & Zaehler & "t")
If [COLOR=#FF0000].ActiveCell[/COLOR].Value = "" Then
objTag_extern.Write 0
Elseif [COLOR=#FF0000].ActiveCell[/COLOR].Value = 0 Or ([COLOR=#FF0000].ActiveCell[/COLOR].Value > 9 And [COLOR=#FF0000].ActiveCell[/COLOR].Value < 9000) Then objTag_extern.Write [COLOR=#FF0000].ActiveCell[/COLOR].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
usw....
End Sub
Set objExcelApp = CreateObject("Excel.Application")
Set objWorkbooks = objExcelApp.Workbooks.Open (GetFileDlgEx)
Set [COLOR=#FF0000]wsExcel[/COLOR] = objWorkbooks.Worksheets("Tabelle1")
'Laufzeiten einlesen
For Zaehler = 1 To 120
[COLOR=#FF0000]wsExcel[/COLOR][COLOR=#FF0000].Range[/COLOR]("B" & Zaehler + 4).Select
Set objTag_extern = HMIRuntime.Tags("PS" & Zaehler & "t")
If [COLOR=#FF0000]wsExcel[/COLOR][COLOR=#FF0000].ActiveCell[/COLOR].Value = "" Then
objTag_extern.Write 0
Elseif [COLOR=#FF0000]wsExcel[/COLOR].ActiveCell.Value = 0 Or ([COLOR=#FF0000]wsExcel[/COLOR].ActiveCell.Value > 9 And [COLOR=#FF0000]wsExcel[/COLOR].ActiveCell.Value < 9000) Then objTag_extern.Write [COLOR=#FF0000]wsExcel[/COLOR].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
usw....
End Sub
Set wshshell = CreateObject("Wscript.shell")
wshshell.regwrite "HKEY_CURRENT_USER\temp\dir", ""
b = ("wscript.exe" & " " & HMIRuntime.ActiveProject.Path & "\library\dialog_öffnen.vbs")
a = CreateObject("Wscript.shell").Run(b,1,True)
key = "HKEY_CURRENT_USER\temp\dir"
If wshshell.regread(key) <> "" Then
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
With objExcelApp
.Workbooks.Open wshshell.regread(key)
Option Explicit
Dim Excel, wshshell
Set wshshell = CreateObject("Wscript.shell")
Set Excel = CreateObject("Excel.Application")
With Excel.FileDialog(3)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel files", "*.xls,*.xlsx"
.InitialFileName = "D:\Belastungsvorgaben"
Excel.Visible = True
Excel.WindowState = -4140 ' Excel - Fenster minimieren
wshshell.AppActivate ("Excel")
.Show
If .SelectedItems.Count = 1 Then
wshshell.regwrite "HKEY_CURRENT_USER\temp\dir", .SelectedItems(1)
End If
End With
@Larry
bist du sicher das
with wsExcel richtig ist? mag zwar funktionieren aber im orginal steht
With objExcelApp
die zeile
Set wsExcel = objWorkbooks.Worksheets("Tabelle1")
hatte ich hinzugefügt, da ich das mit dem with nicht kannte
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
'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)
With objExcelApp
'Laufzeiten einlesen
For Zaehler = 1 To 120
.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
.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
.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
.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 .cells((Zaehler+4),3).value > 0 Then
objTag_extern.Write 1
End If
Next
Next
End With
objExcelApp.Workbooks.Close
' Tabelle schließen
objExcelApp.Quit
' Excel schließen
Set objExcelApp = Nothing
MsgBox "Einlesen der Excel-Datei erfolgreich beendet",vbSystemModal
End Sub
If GetFileDlgEx = Nothing Then
MsgBox "Bitte Datei auswählen",vbSystemModal
Else
Set objExcelApp = CreateObject("Excel.Application")
Set objWorkbooks = objExcelApp.Workbooks.Open (GetFileDlgEx)
With objExcelApp
If GetFileDlgEx = Empty Then
MsgBox "Bitte wählen Sie eine Datei aus",vbSystemModal
Else
Set objExcelApp = CreateObject("Excel.Application")
Set objWorkbooks = objExcelApp.Workbooks.Open (GetFileDlgEx)
With objExcelApp
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?