' Name: D_IBN_Einstellungen_Excel.vbs ' Desc: Exportiert Bauteilattribut D_IBN_Einstellung ' ' '******************************************************************************************************************************************* Include "tools\D_Subroutines.vbs" ' read Subroutines Auslagern von Function/Sub '********************************************** Debug ************************************************************************************** Dim SourceScriptName SourceScriptName = "<< D_INFO_Excel.vbs >> " ' Testmodus / Wechselt in Debugger(Visual Studio) Dim DebugMode 'DebugMode = False ' Aktivmodus DebugMode = True ' Testmodus '********************************************** DIM **************************************************************************************** Dim e3: Set e3 = WScript ' Aktivmodus 'Dim e3: Set e3 = CreateObject( "CT.Application" ) ' Testmodus Dim prj: Set prj = e3.Createjobobject Dim sym: Set sym = prj.CreateSymbolObject Dim txt: Set txt = prj.CreateTextObject Dim dev: Set dev = prj.CreateDeviceObject Dim out: Set out = prj.CreateoutlineObject Dim comp: Set comp = prj.CreateComponentObject Dim slt: Set slt = prj.CreateSlotObject Dim oDicTyp:Set oDicTyp = CreateObject("scripting.dictionary") Dim Pin: Set Pin = prj.CreatePinObject Dim fso, f, p, Excelvorlage Set fso = CreateObject( "Scripting.FileSystemObject" ) Set f = fso.GetFile( WScript.ScriptFullName ) p = f.ParentFolder.Path Excelvorlage = p & "\D_Info_All_Vorlage.xlsm" 'Dim ATTRIBUT_NAME: ATTRIBUT_NAME =e3.getscriptArguments 'Attributname über Parameter übergeben Dim ATT_1, ATT_2, ATT_3, ATT_4, ATT_5, ATT_6, ATT_7 ATT_1 = "D_PJEInfo" ATT_2 = "D_IBN_Einstellung" ATT_3 = "D_IBNINFO" ATT_4 = "D_PruefungInfo" ATT_5 = "D_FertigungINFO" ' Fertigung Info (D) ' ATT_List ATT_6 = "D_NotInBOM" ' Info wenn nicht in Stückliste ATT_7 = "Class" Dim devArtikelnumber Dim DevName, DevLocation, DevAssignment, DevATT, DevTyp Class cmpEntry 'cmpEntry Private Sub Class_Initialize() 'cnt = 1 End Sub Public DevName '" BMK: " & DevNameMountedId &_ Public DevLocation '" ORT: " & DevLocationMountedId &_ Public DevAssignment '" Anlage: " & DevAnlageMountedId &_ Public COMPATT_1 '" Bauteil Attribut Public DevATT_1 '" Betriebsmittel Attribut Public COMPATT_2 '" Bauteil Attribut Public DevATT_2 '" Betriebsmittel Attribut Public COMPATT_3 '" Bauteil Attribut Public DevATT_3 '" Betriebsmittel Attribut Public COMPATT_4 '" Bauteil Attribut Public DevATT_4 '" Betriebsmittel Attribut Public COMPATT_5 '" Bauteil Attribut Public DevATT_5 '" Betriebsmittel Attribut 'Public COMPATT_6 '" Bauteil Attribut Public DevATT_6 '" Betriebsmittel Attribut Public COMPATT_7 '" Klasse Public DevTyp '" ArtikelNr: " & devArtikelnumber &_ Public cnt End Class '******************************************************************************************************************************************* ' Daten Sammeln '------------------------------------------------------------------------------------------------------------------------------------------- '******************************************************************************************************************************************* c = 1 e3.putinfo 0, SourceScriptName & "gestartet" nDev = prj.GetDeviceIds (DevIds) For k = 1 to nDev comp.SetId DevIds( k ) sym.Setid DevIds( k ) dev.Setid DevIds( k ) out.SetId DevIds( k ) 'Test = comp.GetName 'outtyp = out.gettype ' dient zur Überprüfung ob ein Symbol im Panel ' oder Schema platziert worden ist ' Outlinetyp=1 es ist ein Modelsymbol ' Filtereingenschaften: ' - nomales Betriebsmittel ' - original Betriebsmittel ' - Bestandteil der Bauteilliste ' - keine Model '******************************************************************************************************************************************* 'Outlinetyp=1 es ist ein Modelsymbol '******************************************************************************************************************************************* '***************** Bauteil *************************************************************************** If((comp.hasattribute( ATT_1 )) And (comp.GetAttributeValue ( ATT_1 ) <> "")) Or _ ((dev.hasattribute( ATT_1 )) And (dev.GetAttributeValue ( ATT_1 ) <> "")) Or _ ((comp.hasattribute( ATT_2 )) And (comp.GetAttributeValue ( ATT_2 ) <> "")) Or _ ((dev.hasattribute( ATT_2 )) And (dev.GetAttributeValue ( ATT_2 ) <> "")) Or _ ((comp.hasattribute( ATT_3 )) And (comp.GetAttributeValue ( ATT_3 ) <> "")) Or _ ((dev.hasattribute( ATT_3 )) And (dev.GetAttributeValue ( ATT_3 ) <> "")) Or _ ((comp.hasattribute( ATT_4 )) And (comp.GetAttributeValue ( ATT_4 ) <> "")) Or _ ((dev.hasattribute( ATT_4 )) And (dev.GetAttributeValue ( ATT_4 ) <> "")) Or _ ((comp.hasattribute( ATT_5 )) And (comp.GetAttributeValue ( ATT_5 ) <> "")) Or _ ((dev.hasattribute( ATT_5 )) And (dev.GetAttributeValue ( ATT_5 ) <> "")) Or _ ((dev.hasattribute( ATT_6 )) And (dev.GetAttributeValue ( ATT_6 ) <> "")) Then '((comp.hasattribute( ATT_6 )) And (comp.GetAttributeValue ( ATT_6 ) <> "")) Or _ '*****Texte Leeren CompATT_1 = "" DevATT_1 = "" CompATT_2 = "" DevATT_2 = "" CompATT_3 = "" DevATT_3 = "" CompATT_4 = "" DevATT_4 = "" CompATT_5 = "" DevATT_5 = "" 'CompATT_6 = "" DevATT_6 = "" CompATT_7 = "" '***************** DebugPutInfo DebugMode, SourceScriptName, "Zähler : " & k DevName = dev.GetName DevLocation = dev.GetLocation DevAssignment = dev.GetAssignment '+++++++++++++++ ATT 1 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ If((comp.hasattribute( ATT_1 )) And (comp.GetAttributeValue (ATT_1) <> "")) Then CompATT_1 = comp.GetAttributeValue (ATT_1) End If If((dev.hasattribute( ATT_1 )) And (dev.GetAttributeValue (ATT_1) <> "")) Then DevATT_1 = dev.GetAttributeValue ( ATT_1 ) End If If DevATT_1 = CompAtt_1 Then DevATT_1 = "" End If '+++++++++++++++ ATT 2 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ If((comp.hasattribute( ATT_2 )) And (comp.GetAttributeValue (ATT_2) <> "")) Then CompATT_2 = comp.GetAttributeValue (ATT_2) End If If((dev.hasattribute( ATT_2 )) And (dev.GetAttributeValue (ATT_2) <> "")) Then DevATT_2 = dev.GetAttributeValue ( ATT_2 ) End If If DevATT_2 = CompAtt_2 Then DevATT_2 = "" End If '+++++++++++++++ ATT 3 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ If((comp.hasattribute( ATT_3 )) And (comp.GetAttributeValue (ATT_3) <> "")) Then CompATT_3 = comp.GetAttributeValue (ATT_3) End If If((dev.hasattribute( ATT_3 )) And (dev.GetAttributeValue (ATT_3) <> "")) Then DevATT_3 = dev.GetAttributeValue ( ATT_3 ) End If If DevATT_3 = CompAtt_3 Then DevATT_3 = "" End If '+++++++++++++++ ATT 4 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ If((comp.hasattribute( ATT_4 )) And (comp.GetAttributeValue (ATT_4) <> "")) Then CompATT_4 = comp.GetAttributeValue (ATT_4) End If If((dev.hasattribute( ATT_4 )) And (dev.GetAttributeValue (ATT_4) <> "")) Then DevATT_4 = dev.GetAttributeValue ( ATT_4 ) End If If DevATT_4 = CompAtt_4 Then DevATT_4 = "" End If '+++++++++++++++ ATT 5 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ If((comp.hasattribute( ATT_5 )) And (comp.GetAttributeValue (ATT_5) <> "")) Then CompATT_5 = comp.GetAttributeValue (ATT_5) End If If((dev.hasattribute( ATT_1 )) And (dev.GetAttributeValue (ATT_5) <> "")) Then DevATT_5 = dev.GetAttributeValue ( ATT_5 ) End If If DevATT_5 = CompAtt_5 Then DevATT_5 = "" End If '+++++++++++++++ ATT 6 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 'If((comp.hasattribute( ATT_6 )) And (comp.GetAttributeValue (ATT_6) <> "")) Then ' CompATT_6 = comp.GetAttributeValue (ATT_6) 'End If If((dev.hasattribute( ATT_6 )) And (dev.GetAttributeValue (ATT_6) <> "")) Then DevATT_6 = dev.GetAttributeValue ( ATT_6 ) End If 'If DevATT_6 = CompAtt_6 Then ' DevATT_6 = "" 'End If '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '+++++++++++++++ ATT 7 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ If((comp.hasattribute( ATT_7 )) And (comp.GetAttributeValue (ATT_7) <> "")) Then CompATT_6 = comp.GetAttributeValue (ATT_7) End If '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ DevTyp = dev.GetComponentName DebugPutInfo DebugMode, SourceScriptName, "BMK : " & DevAsignment & DevLocation & DevName & " Artikelnr. " & DevTyp & " Attribut " & DevATT Set lvItem = new cmpEntry lvItem.DevName = DevName lvItem.DevLocation = DevLocation lvItem.DevAssignment = DevAssignment lvItem.CompATT_1 = CompATT_1 lvItem.DevATT_1 = DevATT_1 lvItem.CompATT_2 = CompATT_2 lvItem.DevATT_2 = DevATT_2 lvItem.CompATT_3 = CompATT_3 lvItem.DevATT_3 = DevATT_3 lvItem.CompATT_4 = CompATT_4 lvItem.DevATT_4 = DevATT_4 lvItem.CompATT_5 = CompATT_5 lvItem.DevATT_5 = DevATT_5 'lvItem.CompATT_6 = CompATT_6 lvItem.DevATT_6 = DevATT_6 lvItem.CompATT_7 = CompATT_7 lvItem.DevTyp = DevTyp lvItem.cnt = c If( Not oDicTyp.Exists( lvItem.cnt ) ) Then ' Ist Klasse in Liste vorhanden? ' Klasse in die Liste aufnehmen ' mit einem Dictionary als Wert oDicTyp.Add lvItem.cnt, lvItem c = c + 1 End If End If Next '********************************************** Keine Daten im Projekt ******************************************************************************* If c > 1 Then '********************************************** Update Table ******************************************************************************* nline = 2 Set oExcel = CreateObject("Excel.Application") e3.putInfo 0, "Version Excel" & oExcel.Version 'Version 15.0 = 2013 oExcel.Workbooks.Add Excelvorlage 'Definierte Vorlage 'oExcel.Visible = True oExcel.ActiveSheet.Name = "INFO_ALL" DIM Columns Columns = "A:R" '************************************************** Systeme ************************************************ oExcel.ActiveSheet.Columns(Columns).NumberFormat = "@" oExcel.Cells(1,1) = "Nr" oExcel.Cells(1,2) = "Anlage" oExcel.Cells(1,3) = "ORT" oExcel.Cells(1,4) = "Zaehlnr" oExcel.Cells(1,5) = "Artikelnr" oExcel.Cells(1,6) = "Betriebsmittel nicht in Stückliste:" oExcel.Cells(1,7) = "Bauteil:" & ATT_1 oExcel.Cells(1,8) = "Betriebsmittel:" & ATT_1 oExcel.Cells(1,9) = "Bauteil:" & ATT_2 oExcel.Cells(1,10) = "Betriebsmittel:" & ATT_2 oExcel.Cells(1,11) = "Bauteil:" & ATT_3 oExcel.Cells(1,12) = "Betriebsmittel:" & ATT_3 oExcel.Cells(1,13) = "Bauteil:" & ATT_4 oExcel.Cells(1,14) = "Betriebsmittel:" & ATT_4 oExcel.Cells(1,15) = "Bauteil:" & ATT_5 oExcel.Cells(1,16) = "Betriebsmittel:" & ATT_5 oExcel.Cells(1,17) = "Bauteil:" & ATT_7 For li = 1 to 17 oExcel.Cells(,li).Interior.ColorIndex = 44 Next For m = 1 to (c-1) Set vItem = new cmpEntry Set vItem = oDicTyp (m) oExcel.Cells( nline, 1 ) = vItem.cnt oExcel.Cells( nline, 2 ) = vItem.DevAssignment oExcel.Cells( nline, 3 ) = vItem.DevLocation oExcel.Cells( nline, 4 ) = vItem.DevName oExcel.Cells( nline, 5 ) = vItem.DevTyp oExcel.Cells( nline, 6 ) = vItem.DevATT_6 oExcel.Cells( nline, 7 ) = vItem.CompATT_1 oExcel.Cells( nline, 8 ) = vItem.DevATT_1 oExcel.Cells( nline, 9 ) = vItem.CompATT_2 oExcel.Cells( nline, 10 ) = vItem.DevATT_2 oExcel.Cells( nline, 11 ) = vItem.CompATT_3 oExcel.Cells( nline, 12 ) = vItem.DevATT_3 oExcel.Cells( nline, 13 ) = vItem.CompATT_4 oExcel.Cells( nline, 14 ) = vItem.DevATT_4 oExcel.Cells( nline, 15 ) = vItem.CompATT_5 oExcel.Cells( nline, 16 ) = vItem.DevATT_5 oExcel.Cells( nline, 17 ) = vItem.CompATT_7 nline = nline + 1 Next oExcel.ActiveSheet.Columns(Columns).AutoFit oExcel.Visible = True 'Erhöhte Performance wenn erst nach dem Füllen Sichtbar! On Error Resume Next oExcel.ActiveWorkbook.SaveAs prj.GetPath & prj.GetName & "_Info_All" 'ExcelName Else e3.PutError 1, SourceScriptName & " " & ATT_List & " Kein Attribut-Eintrag definiert!" End If e3.putinfo 0, SourceScriptName & "beendet" '********************************************** NOTHING ************************************************************************************ Set dlg = nothing Set out = Nothing Set dev = Nothing Set sym = Nothing Set prj = Nothing Set e3 = Nothing Set txt = Nothing Set oDicTyp = Nothing '******************************************************************************************************************************************* '* Function/Sub '******************************************************************************************************************************************* '------------------------------------------------------------------------------ Include() ------------------ ' [4rk] >> Function Include( FileName ) Dim fso, f, s Dim p, fn, found Set fso = CreateObject( "Scripting.FileSystemObject" ) Set f = fso.GetFile( WScript.ScriptFullName ) p = f.ParentFolder.Path fn = p & "\" & Filename found = False If fso.FileExists( fn ) Then found = True Set f = fso.OpenTextFile( fn, 1, False, -2 ) ' System Default Else Dim pos, pa pos = InStrRev ( p, "\" ) pa = Left ( p, pos-1 ) fn = pa & "\" & Filename If fso.FileExists( fn ) Then found = True Set f = fso.OpenTextFile( fn, 1, False, -2 ) ' System Default End If End If If found Then s = f.ReadAll : f.Close ExecuteGlobal s Else MsgBox ("File not found: " & fn) WScript.Quit End If End Function ' << [4rk]