| |
| KISTERS 3DViewStation: Effektiver Know-how-Schutz von sensiblen Produktdaten, eine Pressemitteilung
|
Autor
|
Thema: Stückliste Makro (14030 mal gelesen)
|
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 18. Okt. 2013 08:02 <-- editieren / zitieren --> Unities abgeben:
Servus, laufen tut der Code bei mir auch mit deiner Änderung. Problem ist eben nur das er nur noch Einbaulevel, Partname und Menge ausgibt und keinerlei Parameter mehr ausließt. Also den Code den ich gepostet habe ist ja so ziemlich der originale von DasDon und da füge ich die Änderungsvorschläge ein. Und dann habe ich noch nen zweiten Code als Bastelstube an dem ich rumexperimentier (der ist allerding noch ohne deine Änderung). Der sieht wie folgt aus: ------------------------------------------------------------------------------------------ Dim xlSheet As Excel.Worksheet dim objXL As Object dim oAWBook As Object dim oDict1 As Object dim sPath As String sPath = "C:\Users\fulrich\Desktop\Stuecklisten_Makro\Stueckliste\Stueckliste_Vorlage.xls" '---------------------------------------- Sub CATMain() setUpExcel CATIA.ActiveDocument.Product.ApplyWorkMode DESIGN_MODE TreeWalk CATIA.ActiveDocument.Product, 0 , 0, 1 END_MESSAGE End Sub '----------------------------------------
'---------------------------------------- Sub setUpExcel() ' Exel Öffnen Set objXL = CreateObject("Excel.Application") Set sPath = objXL.Workbooks.Open(sPath) Set xlSheet = objXL.ActiveSheet objXL.Visible = True End Sub '---------------------------------------- '---------------------------------------- Sub WriteToExcel(byVal prod As product, byVal i As Integer, byVal quantity As Integer, byVal eibauLvl as Integer) objXL.Cells(12+i,1).Value = eibauLvl objXL.Cells(12+i,4).Value = quantity objXL.Cells(12+i,5).Value = prod.PartNumber On error resume next objXL.Cells(12+i,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString objXL.Cells(12+i,11).Value = prod.Parameters.Item("Material").ValueAsString objXL.Cells(12+i,23).Value = prod.Parameters.Item("Masse").ValueAsString objXL.Cells(12+i,15).Value = prod.Parameters.Item("Durchmesser").ValueAsString objXL.Cells(12+i,17).Value = prod.Parameters.Item("Laenge").ValueAsString objXL.Cells(12+i,19).Value = prod.Parameters.Item("Breite").ValueAsString objXL.Cells(12+i,21).Value = prod.Parameters.Item("Hoehe").ValueAsString objXL.Cells(12+i,13).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString objXL.Cells(12+i,22).Value = prod.Parameters.Item("Produktart").ValueAsString End Sub '---------------------------------------- '---------------------------------------- Sub treewalk(byVal oProd As Product, byref lvlCounter As intger, byref eibauLvl as Integer, byVal assyCount As Integer) dim oChild as Product dim oDict1 as Object dim oDict2 as Object Set oDict1 = CreateObject("Scripting.Dictionary") 'keeps item quantity Set oDict2 = CreateObject("Scripting.Dictionary") 'keeps part item print state dim oDict3 as Object Set oDict3 = CreateObject("Scripting.Dictionary") 'keeps part item print state of prod ' gets components count for each oChildCount in oProd.Products if oDict1.Exists(oChildCount.PartNumber) then oDict1.Item(oChildCount.PartNumber) = oDict1.Item(oChildCount.PartNumber) +1 else oDict1.Add(oChildCount.PartNumber), 1 End If Next objXL.Cells(lvlCounter +12, 1).value = eibauLvl objXL.Cells(lvlCounter +12, 5).value = oProd.PartNumber objXL.Cells(lvlCounter +12, 3).Value = assyCount for each oChild in oProd.Products lvlCounter = lvlCounter + 1 if oChild.Products.Count > 0 then 'product has children if oDict3.Exists(oChild.PartNumber) = false then oDict3.Add(oChild.PartNumber), "printed" TreeWalk oChild, lvlCounter , eibauLvl +1, oDict1.Item(oChild.PartNumber) end if else if oDict2.Exists(oChild.PartNumber) then lvlCounter = lvlCounter - 1 else oDict2.Add(oChild.PartNumber), true WriteToExcel oChild, lvlCounter, oDict1.Item(oChild.PartNumber), eibauLvl +1 end if end if next End Sub '---------------------------------------- Dieser Code schreibt jetzt in meine Vordefinierte Excelvorlage. Das einzige was noch fehlt, ist das die 3 Paramter der Unterbaugruppen mit ausgegeben werden und ich versuche gerade rauszufinden ob es einen Weg gibt mehrere Parameter in einer Zelle auszugeben >>> "Durchmesser" x "Laenge" x "Breite" x "Hoehe" Dann muss man zwar die "Nullwerte" per Hand löschen, aber das wird ja wohl kaum das Problem sein. Weil eine Funktion welche analysiert welche Werte "Null" sind und diese Werte weglässt ist, so denke ich recht aufwendig und würde den Ramen sprengen xD [Diese Nachricht wurde von shoutz000 am 18. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 18. Okt. 2013 08:27 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus In deinem Code fehlt das ".RootParameterSet.DirectParameters.Item". Versuch mal an einem TestTeil/Baugruppe direkt vom Product über "RootParameterSet.DirectParameters.Item" den Parameter auszugeben. Bei mir hat er die Parameter richtig ausgegeben. Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 18. Okt. 2013 08:59 <-- editieren / zitieren --> Unities abgeben:
|
DasDon Mitglied Konstruktuer
Beiträge: 169 Registriert: 25.07.2011 R18 SP2. WIN
|
erstellt am: 18. Okt. 2013 10:23 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Ich habe jetzt einen Testbaugruppe bekommen und werde nun das makro so ändern wie Bernd es vorschlug und schauen ob es hinhaut....poste dann das Script bei fertigstellung wieder....oder auch nicht...habe nur R18 installiert. Vermute du hast es mit R19 gemacht...schade. Kriegen wir auch so hin. [Diese Nachricht wurde von DasDon am 18. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 18. Okt. 2013 10:31 <-- editieren / zitieren --> Unities abgeben:
|
DasDon Mitglied Konstruktuer
Beiträge: 169 Registriert: 25.07.2011 R18 SP2. WIN
|
erstellt am: 18. Okt. 2013 10:31 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
einfach...du hast zwei verschiedene Version zusammen gefahren.
Code: objXL.Cells(lvlCounter +12, 1).value = eibauLvl objXL.Cells(lvlCounter +12, 5).value = oProd.PartNumber objXL.Cells(lvlCounter +12, 3).Value = assyCount
diese Zeilen (v2) müssen durch diese Zeilen (v4)
Code: WriteToExcel oProd, excelRow, assyCount, instalLvl
ausgetacuscht werden... allerdings hast du die Variablen Namen wie sie in V4 sind, nicht in V2. Warte einfach mal ein wenig und ich korrigiere es.... Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DasDon Mitglied Konstruktuer
Beiträge: 169 Registriert: 25.07.2011 R18 SP2. WIN
|
erstellt am: 18. Okt. 2013 10:48 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Moin Bernd, Ich habe in VBA-Editor folgendes eingegebn, und als Watch benutzt. Code:
Sub CATMain() CATIA.ActiveDocument.Product.Products.Item (1) End Sub
Product Structure = Prod1 -prod2 --part1 --part2 --part2 -prod3 --part3 -prod3 --part3 Schaue ich im Watch Fenster in Parameters.RootParameters finde ich dort the RootParameterSet failed. Schaue mach ich aber folgendes: Code:
Sub CATMain() Set A = CATIA.ActiveDocument.Product End Sub
Ist a.Parameters.RootParameters vorhaden, allerdings relative unnützlich (z.Z). Unter DirectParameters ist Count=0 aber im .Units finde ich count=700 und alle Parameter wieder...werde mal ein wenig rumschauen müssen nach eine Lösung die schneller ist als for each... Gruß, Dean
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 18. Okt. 2013 12:19 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus Hast du auch in den entsprechenden CATParts bzw CATProducts einen Parameter erzeugt? Sonst wird ein Fehler ausgegeben (Fehlerbehandlung wenn ein Teil nicht den Vorgaben (=Parametern) entspricht) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 21. Okt. 2013 16:14 <-- editieren / zitieren --> Unities abgeben:
Hallo ich hatte ja bereits angesprochen das ich mehrere Parameter in einer Zelle haben möchte. >>> "Durchmesser"x"Laenge"x"Breite"x"Hoehe" Dies habe ich wie folgt gelöst: --------------------------------------------------------------- Sub WriteToExcel(byVal prod As product, byVal i As Integer, byVal quantity As Integer, byVal eibauLvl as Integer) objXL.Cells(3+i,1).Value = eibauLvl objXL.Cells(3+i,3).Value = quantity objXL.Cells(3+i,4).Value = prod.PartNumber On error resume next objXL.Cells(3+i,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString objXL.Cells(3+i,5).Value = prod.Parameters.Item("Material").ValueAsString objXL.Cells(3+i,6).Value = prod.Parameters.Item("Masse").ValueAsString objXL.Cells(3+i,7).Value = prod.Parameters.Item("Durchmesser").ValueAsString objXL.Cells(3+i,8).Value = prod.Parameters.Item("Laenge").ValueAsString objXL.Cells(3+i,9).Value = prod.Parameters.Item("Breite").ValueAsString objXL.Cells(3+i,10).Value = prod.Parameters.Item("Hoehe").ValueAsString objXL.Cells(3+i,11).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString objXL.Cells(3+i,12).Value = prod.Parameters.Item("Produktart").ValueAsString objXL.Cells(3+i,13).Value = objXL.Cells(3+i,7) & "x" & objXL.Cells(3+i,8) & "x" & objXL.Cells(3+i,9) & "x" & objXL.Cells(3+i,10) End Sub --------------------------------------------------------------- Problem ist nun das ich diese Angaben natürlich nur einmal benötige, daher müssen die 4 Zellen mit den Einzelwerten im Anschluss gelöscht werden.... bloß wie?
Oder es gibt ein Script mit dem direkt alle 4 Paramter zusammen in eine Zelle geschrieben werden können... ...aber dazu habe ich nichts gefunden und selber nur Fehlermeldungen produziert :-P [Diese Nachricht wurde von shoutz000 am 21. Okt. 2013 editiert.] [Diese Nachricht wurde von shoutz000 am 21. Okt. 2013 editiert.] [Diese Nachricht wurde von shoutz000 am 21. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 21. Okt. 2013 16:41 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus zB so: Code: sDurchmesser= prod.Parameters.Item("Durchmesser").ValueAsString sLaenge = prod.Parameters.Item("Laenge").ValueAsString sBreite = prod.Parameters.Item("Breite").ValueAsString sHoehe = prod.Parameters.Item("Hoehe").ValueAsStringobjXL.Cells(3+i,13).Value = sDurchmesser & "x" & sLaenge & "x" & sBreite & "x" & sHoehe
oder eben ohne Zwischenvariablen Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 24. Okt. 2013 09:28 <-- editieren / zitieren --> Unities abgeben:
Morgen, funzt wunderbar muss also doch keine Zellen nachträglich löschen. Vielen Dank. Gibt es eine Möglichketi die Maßeinheit zu löschen? Momentan steht es so da: 0mmx20mmx20mmx20mm soll aber so sein 0x20x20x20 Ich habe es über eine Excelformatierung versucht, aber selbst wenn die Zellen auf Zahlen formatiert sind behält er die "mm" bei. Versucht habe ich auch statt "asString" "asInteger" einzusetzen, allerdings überträgt er dann gar keine Daten mehr... ...und wieder was gelernt xD Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 24. Okt. 2013 09:51 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
|
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 24. Okt. 2013 10:27 <-- editieren / zitieren --> Unities abgeben:
|
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 28. Okt. 2013 12:19 <-- editieren / zitieren --> Unities abgeben:
Moinmoin und mal wieder ein Problem xD ich möchte eine inputbox erstellen die mehrere Daten abfrägt und dann in Excel eintragen soll. Code V1: dim myFunc1 As String myFunc1 = InputBox ("Bitte Ihren Nachnamen eingeben.", "Bearbeiter", "Nachname") objXL.Cells(3,6).Value = myFunc1.ValueAsString >>>Bei dieser Version kommt nach der Eingabe eine Fehlermeldung: Objekt erforderlich: 'myFunc1' Code V2:
dim myFunc1 As String myFunc1 = InputBox ("Bitte Ihren Nachnamen eingeben.", "Bearbeiter", "Nachname") objXL.Cells(3,6).Value = myFunc1 >>>Hier kommt keine Fehlermeldung aber es wird auch nichts in Excel geschrieben... Was mach ich falsch?!?!
Und gibt es eine Möglichkeit mehrere Angaben in einer Inputbox abzufragen? Habe hierzu nicht viel hilfreiches gefunden im Bereich Excel selber gabs ne Menge was mir allerdings nicht weitergeholfen hat :-( Grüße
[Diese Nachricht wurde von shoutz000 am 28. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
imation1999 Mitglied dipl.-ing. Maschinenbau
Beiträge: 276 Registriert: 02.08.2011 Dell Precision T3500 Intel® Xeon® Quad Core NVIDIA Quadro® 5000 Win7 x64 Ultimate CATIA V5 R20 SP2
|
erstellt am: 28. Okt. 2013 12:53 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Hallo, mit "Code V2" soll es funktionieren. Wohin hast Du die Code zugefügt? Kann es sein, wird später diese Zelle überschreiben? [Diese Nachricht wurde von imation1999 am 28. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 28. Okt. 2013 12:57 <-- editieren / zitieren --> Unities abgeben:
Also mit V2 geb ich den Wert ein und das Makro läuft dann komplett durch ohne Fehlermeldung. Aber er schreibt den Wert nicht in besagte Zelle. Nein die wird nicht überschrieben. Alle Zellen welche von dem Makro genutzt werden liegen unterhalb. Hier ist die Codezeile eingebaut:
Dim xlSheet As Excel.Worksheet dim objXL As Object dim oAWBook As Object dim oDict1 As Object dim oDict2 As Object dim oDict3 As Object dim sPath As String sPath = "C:\Users\fulrich\Desktop\Stuecklisten_Makro\Stueckliste\Stueckliste_Vorlage.xls" '---------------------------------------- Sub CATMain() setUpExcel CATIA.ActiveDocument.Product.ApplyWorkMode DESIGN_MODE TreeWalk CATIA.ActiveDocument.Product, 0 , 0, 1 END_MESSAGE End Sub '---------------------------------------- '---------------------------------------- Sub setUpExcel() 'Exel Öffnen Set objXL = CreateObject("Excel.Application") Set sPath = objXL.Workbooks.Open(sPath) Set xlSheet = objXL.ActiveSheet objXL.Visible = True
dim myFunc1 As String myFunc1 = InputBox ("Bitte Ihren Nachnamen eingeben.", "Bearbeiter", "Nachname") objXL.Cells(3,6).Value = myFunc1.ValueAsString ....... [Diese Nachricht wurde von shoutz000 am 28. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 28. Okt. 2013 12:58 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus Code V2 sollte eigentlich passen. hast du auch einen Namen angeben (mit MsgBox ausgeben lassen)? Wie hast du den Fehler schon untersucht bzw eingeschränkt? In CATScript kannst du nur Inputboxen mit einem Input verwenden (oder zB Input mit Komma trennen und dann entsprechend prüfen und zerlegen). Oder du musst auf VBA (bzw CATVBA) wechseln. Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 28. Okt. 2013 13:01 <-- editieren / zitieren --> Unities abgeben:
Wie mit msgBox ausgeben? Hab nur das geschrieben was oben steht... Neeee dann lieber mehrere Intuptboxen weil das ganze jetzt umschreiben... ...da fang ich ja wieder bei Null an [Diese Nachricht wurde von shoutz000 am 28. Okt. 2013 editiert.] [Diese Nachricht wurde von shoutz000 am 28. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 28. Okt. 2013 13:22 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
|
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 28. Okt. 2013 13:32 <-- editieren / zitieren --> Unities abgeben:
Haha so ein f..... mein ursprünglicher Code hat eigentlich auch gefunzt Problem war nur das ich in eine Excelvorlage schreibe und diese Zelle war falschformatiert. Hab die Formatierung gelöscht und beides ausprobiert und beides hat funktioniert xD. Aber natürlich trotzdem Vielen Dank :-) Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 28. Okt. 2013 14:47 <-- editieren / zitieren --> Unities abgeben:
Sooo der vorletzte Schritt... nun ist es daran das ganze etwas übersichtlicher zu machen... ...den Großteil hat ja dasDon geschrieben (Vielen Dank nochmal) und das Makro schreibt zuerst alle Baugruppen auf, dann macht es zwei Leerzeilen rein und dann kommen die restlichen Parts. So ich möchte jetzt aber nach jeder Unterbaugruppe eine Leerzeile haben. Ich such mir schon nen Wolf in dem Script, veränder Wert um Wert und es passiert alles nur nicht das was ich will Weiß einer von euch wo das definiert ist oder definiert werden muss? oO Code: -------------------------------------------------------------------- Dim xlSheet As Excel.Worksheet dim objXL As Object dim oAWBook As Object dim oDict1 As Object dim oDict2 As Object dim oDict3 As Object dim sPath As String sPath = "C:\Users\Stueckliste_Vorlage.xls"
'---------------------------------------- Sub CATMain() setUpExcel CATIA.ActiveDocument.Product.ApplyWorkMode DESIGN_MODE TreeWalk CATIA.ActiveDocument.Product, 0 , 0, 1 END_MESSAGE End Sub '----------------------------------------
'---------------------------------------- Sub setUpExcel() 'Exel Öffnen Set objXL = CreateObject("Excel.Application") Set sPath = objXL.Workbooks.Open(sPath) Set xlSheet = objXL.ActiveSheet objXL.Visible = True 'Eingabeaufforderungen für den Schriftkopf dim myFunc1 As String myFunc1 = InputBox ("Bitte geben Sie Ihren Namen ein.", "Angabe 1 von 8", "V.Name") objXL.Cells(6,4).Value = myFunc1 dim myFunc2 As String myFunc2 = InputBox ("Bitte geben Sie das aktuelle Datum ein.", "Angabe 2 von 8", "XX.YY.CCCC") objXL.Cells(7,4).Value = myFunc2 dim myFunc3 As String myFunc3 = InputBox ("Bitte geben Sie Auftragsnummer ein.", "Angabe 3 von 8", "XXXXXXXX-Y-CC") objXL.Cells(4,6).Value = myFunc3 objXL.Cells(6,6).Value = myFunc3 objXL.Cells(5,11).Value = myFunc3 dim myFunc4 As String myFunc4 = InputBox ("Bitte geben Sie die Bezeichnung der Baugruppe ein.", "Angabe 4 von 8", "XXXXXXXX-Y-CC_Bezeichnung") objXL.Cells(5,6).Value = myFunc4 dim myFunc5 As String myFunc5 = InputBox ("Bitte geben Sie den Kunden ein.", "Angabe 5 von 8", "Kunde") objXL.Cells(6,9).Value = myFunc5 dim myFunc6 As String myFunc6 = InputBox ("Bitte geben Sie die Baugruppe ein.", "Angabe 6 von 8", "Baugruppe") objXL.Cells(7,9).Value = myFunc6 dim myFunc7 As String myFunc7 = InputBox ("Bitte geben Sie den Gerätetyp ein.", "Angabe 7 von 8", "Gerätetyp") objXL.Cells(7,6).Value = myFunc7 dim myFunc8 As String myFunc8 = InputBox ("Bitte geben Sie den Kostenträgere ein.", "Angabe 8 von 8", "Kostenträgere") objXL.Cells(4,11).Value = myFunc8 End Sub '---------------------------------------- '---------------------------------------- Sub WriteToExcel(byVal prod As product, byVal i As Integer, byVal quantity As Integer, byVal eibauLvl as Integer) 'Print-Ziel festlegen objXL.Cells(11+i,1).Value = eibauLvl objXL.Cells(11+i,3).Value = quantity objXL.Cells(11+i,4).Value = prod.PartNumber On error resume next sDurchmesser= CStr(prod.Parameters.Item("Durchmesser").Value) sLaenge = CStr(prod.Parameters.Item("Laenge").Value) sBreite = CStr(prod.Parameters.Item("Breite").Value) sHoehe = CStr(prod.Parameters.Item("Hoehe").Value) objXL.Cells(11+i,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString objXL.Cells(11+i,7).Value = prod.Parameters.Item("Material").ValueAsString objXL.Cells(11+i,9).Value = "d" & sDurchmesser & "x" & sLaenge & "x" & sBreite & "x" & sHoehe objXL.Cells(11+i,8).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString objXL.Cells(11+i,10).Value = prod.Parameters.Item("Produktart").ValueAsString objXL.Cells(11+i,11).Value = prod.Parameters.Item("Masse").ValueAsString End Sub '---------------------------------------- '---------------------------------------- Sub treewalk(byVal oProd As Product, byref lvlCounter As intger, byref eibauLvl as Integer, byVal assyCount As Integer) 'Strukturbaum durchsuchen dim oChild as Product dim oDict1 as Object dim oDict2 as Object dim oDict3 as Object Set oDict1 = CreateObject("Scripting.Dictionary") 'keeps item quantity Set oDict2 = CreateObject("Scripting.Dictionary") 'keeps part item print state Set oDict3 = CreateObject("Scripting.Dictionary") 'keeps part item print state of prod 'Teile zählen for each oChildCount in oProd.Products if oDict1.Exists(oChildCount.PartNumber) then oDict1.Item(oChildCount.PartNumber) = oDict1.Item(oChildCount.PartNumber) +1 else oDict1.Add(oChildCount.PartNumber), 1 End If Next objXL.Cells(lvlCounter +11, 1).value = eibauLvl objXL.Cells(lvlCounter +11, 4).value = oProd.PartNumber objXL.Cells(lvlCounter +11, 3).Value = assyCount for each oChild in oProd.Products lvlCounter = lvlCounter + 1 if oChild.Products.Count > 0 then 'Product hat Kind if oDict3.Exists(oChild.PartNumber) = false then oDict3.Add(oChild.PartNumber), "printed" TreeWalk oChild, lvlCounter , eibauLvl +1, oDict1.Item(oChild.PartNumber) end if else if oDict2.Exists(oChild.PartNumber) then lvlCounter = lvlCounter - 1 else oDict2.Add(oChild.PartNumber), true WriteToExcel oChild, lvlCounter, oDict1.Item(oChild.PartNumber), eibauLvl +1 end if end if next End Sub ------------------------------------------------------------------ [Diese Nachricht wurde von shoutz000 am 28. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 29. Okt. 2013 06:18 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus Vermutlich musst du dort wo der Treewalk für die Unterbaugruppe aufgerufen wird nur den Zähler um eins erhöhen (+2 statt +1) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 29. Okt. 2013 06:53 <-- editieren / zitieren --> Unities abgeben:
|
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 29. Okt. 2013 07:34 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus Was zählt er falsch? Schon mal probiert an der gleichen Stelle den "lvlCounter" um eins zu erhöhen? Gruß Bernd PS: Bitte erklär besser was nicht geht, so allgemeine Aussagen "geht nicht" bringen niemandem etwas. Ggf antworten weniger Leute, da sie nicht Lust haben dir "alles aus der Nase zu ziehen" ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 29. Okt. 2013 07:54 <-- editieren / zitieren --> Unities abgeben:
Wenn ich den Wert welchen du gesagt hast erhöhe, zählt er die Bauteile falsch. Also er gibt mehr Parts an als eigentlich enthalten sind im 3D. Erhöhe ich den "lvlCounter" auf 2 macht er nach jedem Element eine Leerzeile wodurch die Liste dann extrem gestrekt ist. Es soll aber nur nach jeder Baugruppe eine Leerzeile rein. Sub treewalk(byVal oProd As Product, byref lvlCounter As intger, byref eibauLvl as Integer, byVal assyCount As Integer) 'Strukturbaum durchsuchen dim oChild as Product dim oDict1 as Object dim oDict2 as Object dim oDict3 as Object Set oDict1 = CreateObject("Scripting.Dictionary") 'keeps item quantity Set oDict2 = CreateObject("Scripting.Dictionary") 'keeps part item print state Set oDict3 = CreateObject("Scripting.Dictionary") 'keeps part item print state of prod
'Teile zählen for each oChildCount in oProd.Products if oDict1.Exists(oChildCount.PartNumber) then oDict1.Item(oChildCount.PartNumber) = oDict1.Item(oChildCount.PartNumber) +1 (erhöhe ich den Wert werden die Parts falsch gezählt) else oDict1.Add(oChildCount.PartNumber), 1 (Erhöhe ich den Wert auf 2 wird zu jedem enthaltenem Element "1" mehr dazu gezählt) End If Next objXL.Cells(lvlCounter +3, 1).value = eibauLvl objXL.Cells(lvlCounter +3, 3).Value = assyCount objXL.Cells(lvlCounter +3, 4).value = oProd.PartNumber for each oChild in oProd.Products lvlCounter = lvlCounter + 1 if oChild.Products.Count > 0 then 'Product hat Kind if oDict3.Exists(oChild.PartNumber) = false then oDict3.Add(oChild.PartNumber), "printed" TreeWalk oChild, lvlCounter , eibauLvl +1, oDict1.Item(oChild.PartNumber) end if else if oDict2.Exists(oChild.PartNumber) then lvlCounter = lvlCounter - 1 else oDict2.Add(oChild.PartNumber), true WriteToExcel oChild, lvlCounter, oDict1.Item(oChild.PartNumber), eibauLvl +1 end if end if next End Sub [Diese Nachricht wurde von shoutz000 am 29. Okt. 2013 editiert.]
[Diese Nachricht wurde von shoutz000 am 29. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 29. Okt. 2013 07:57 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus Du hast das Makro noch nicht verstanden (bitte mal schrittweise abarbeiten lassen und versuchen nachzuvollziehen). Ich meine in der Zeile Code: TreeWalk oChild, lvlCounter , eibauLvl +1, oDict1.Item(oChild.PartNumber)
entweder den "lvlCounter" oder den "eibauLvl" variieren (eher lvlCounter) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 29. Okt. 2013 08:12 <-- editieren / zitieren --> Unities abgeben:
Achso ok... ...ja bin dabei ständig zu schauen was für was ist... dauert aber noch ein wenig glaub eich ;-) Also sehr komisches Ergebnis: Wenn ich eibauLvl erhöhe wird genau der Wert einfach nur in Excel erhöht. Änder ich allerdings lvlCounter macht er was sehr merkwürdiges. In Excel erscheinen Daten die er eingibt und diese werden dann ständig überschrieben, hüpfen hin und her uund letztendlich stehen dann alle Products untereinander und dann alle Parts und von Leerzeilen keine Spur :-P Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 29. Okt. 2013 08:26 <-- editieren / zitieren --> Unities abgeben:
Ich habe jetzt hier noch den Wert "+1" dahintergeschrieben: WriteToExcel oChild, lvlCounter +1, oDict1.Item(oChild.PartNumber), eibauLvl +1 Dann macht er auch tatsächlich hinter jedem Product eine Leerzeile. Problem hierbei ist das dies so nicht gedacht ist. Er soll ja nach einer kompletten Baugruppe erst eine Leerzeile machen damit es übersichtlicher ist also so: Product1 - PartX - PartY Product2 - PartZ ... Er macht es allerdings so:
Product1 - PartX - PartY Product2 - PartZ ... [Diese Nachricht wurde von shoutz000 am 29. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
imation1999 Mitglied dipl.-ing. Maschinenbau
Beiträge: 276 Registriert: 02.08.2011 Dell Precision T3500 Intel® Xeon® Quad Core NVIDIA Quadro® 5000 Win7 x64 Ultimate CATIA V5 R20 SP2
|
erstellt am: 29. Okt. 2013 09:47 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
|
DasDon Mitglied Konstruktuer
Beiträge: 169 Registriert: 25.07.2011 R18 SP2. WIN
|
erstellt am: 29. Okt. 2013 10:15 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Moin moin, das Problem liegt bei der For-Schleife. Da er die Parts gruppieren muss, muss ständige der Excelreihezähler verändert, bzw angepasst werden. Dies geschieht bei Parts hier: if oDict2.Exists(oChild.PartNumber) then lvlCounter = lvlCounter - 1 bei Baugruppen habe ich es wohl vergessen. Die Leerezeilen tauchen dann auf, sobald eine Baugruppe mehr als einmal Installiert ist. Der lvlCounter wird hochgezählt für jedes Kind. Um das zu lösen, muss bei der Fesetullung das die Baugruppe schon exportiert werden, wieder der Zähler nach unten korrigiert werden. Folgendes muss hinzugefügt werden: Code:
'Product hat Kind if oDict3.Exists(oChild.PartNumber) = false then oDict3.Add(oChild.PartNumber), "printed" TreeWalk oChild, lvlCounter , eibauLvl +1, Dict1.Item(oChild.PartNumber) lvlCounter = lvlCounter + 1 ' damit erzeugt man die Leerzeile nach jeder Baugruppe else lvlCounter = lvlCounter - 1 'anpassung der Excelreihe end if
Damit müsste es hinhauen. Gruß, Dean PS: ich würde aber eigentlich davon abraten, eine leere Zeile in Excel hinzu zu fügen, damit werden die Filter etwas komplizierter. Lieber würde ich eine Extra Sub hinzufügen der die Reihe Untersctriecht oder Fett macht...
[Diese Nachricht wurde von DasDon am 29. Okt. 2013 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 29. Okt. 2013 10:29 <-- editieren / zitieren --> Unities abgeben:
|
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 29. Okt. 2013 10:40 <-- editieren / zitieren --> Unities abgeben:
|
DasDon Mitglied Konstruktuer
Beiträge: 169 Registriert: 25.07.2011 R18 SP2. WIN
|
erstellt am: 29. Okt. 2013 10:46 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Moin, wäre das hier evtl nicht etwas besser als die ganzen benutzer eingaben?
Code:
myFunc1 = CATIA.SystemService.Environ("USERNAME") 'angabe 1 von 8 myFunc2 = CStr(Date) 'angabe 2 von 8 myFunc4 = CATIA.ActiveDocument.Product.Nomenclature ' angabe 4 von 8 myFunc6 = CATIA.ActiveDocument.Product.PartNumber ' angabe 6 von 8
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 29. Okt. 2013 10:55 <-- editieren / zitieren --> Unities abgeben:
|
DasDon Mitglied Konstruktuer
Beiträge: 169 Registriert: 25.07.2011 R18 SP2. WIN
|
erstellt am: 29. Okt. 2013 11:11 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Moin, so: objXL.Cells(lvlCounter +3, 1).value = eibauLvl objXL.Cells(lvlCounter +3, 3).Value = assyCount objXL.Cells(lvlCounter +3, 4).value = oProd.PartNumber objXL.Rows(lvlCounter +3).Font.Bold = True ' Baugruppe wird Fettgedruckt gruß, Dean
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
shoutz000 Mitglied Techn. Produktdesigner
Beiträge: 168 Registriert: 19.08.2013 CatiaV5 R19 CatiaV5 R24 Windows 7 Professional
|
erstellt am: 29. Okt. 2013 11:19 <-- editieren / zitieren --> Unities abgeben:
|
DasDon Mitglied Konstruktuer
Beiträge: 169 Registriert: 25.07.2011 R18 SP2. WIN
|
erstellt am: 31. Okt. 2013 10:05 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Moin moin, Ich hatte mal wieder etwas Zeit das hier genauer an zuschauen und möchte es nun abzuschließen: Bernd, du hattest Recht mit dem RootParameterSet.DirectParameters! Allerdings Funktioniert das nur bei Assemblies. Darum habe ich einen String(passedType) übergeben beim Aufruf vom WriteToExcel der angibt ob das Kind einen Part oder einen Product ist. Code:
'Fehlerbehandlung abschalten On Error Resume Next Select Case passedType case "Product" objXL.Cells(excelRow,2).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Pos_Nr.").ValueAsString objXL.Cells(excelRow,8).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("DIN EN ISO").ValueAsString objXL.Cells(excelRow,10).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Produktart").ValueAsString case "Part" 'collect dimension parameters sDurchmesser= prod.Parameters.Item("Durchmesser").ValueAsString sLaenge = prod.Parameters.Item("Laenge").ValueAsString sBreite = prod.Parameters.Item("Breite").ValueAsString sHoehe = prod.Parameters.Item("Hoehe").ValueAsString 'Parameter auslesen und in Excel eintragen objXL.Cells(excelRow,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString objXL.Cells(excelRow,7).Value = prod.Parameters.Item("Material").ValueAsString objXL.Cells(excelRow,9).Value = "d" & sDurchmesser & "x" & sLaenge & "x" & sBreite & "x" & sHoehe objXL.Cells(excelRow,8).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString objXL.Cells(excelRow,10).Value = prod.Parameters.Item("Produktart").ValueAsString objXL.Cells(excelRow,11).Value = prod.Parameters.Item("Masse").ValueAsString End Select 'Fehlerbehandlung einschalten
Anbei ist auch das Komplette Makro. Gruß, Dean Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Esterbauer Mitglied
Beiträge: 62 Registriert: 26.09.2008
|
erstellt am: 04. Jan. 2018 08:38 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Hallo, Hätte eine Frage zur Stückliste. Die Stückliste funktioniert soweit ganz gut es gibt aber zwei Sachen die für mich nicht ganz passen. - Wenn ein Produkt öfters in einem Produkt verbaut ist und dieses Parts beinhaltet, wird nur die Menge vom Produkt und nicht vom den Part gezählt. (gelb markiert) - Gibt es die Möglichkeit das die Produkte nicht in der Stückliste aufgenommen werden.(blau markiert) - Gibt es die Möglichkeit das Basismodelle (Parts) nicht in der Stückliste mit aufgenommen werden..(orange markiert) wer hätte da eine Idee
Danke
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 04. Jan. 2018 11:05 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus Bevor du das Makro an deine Vorgaben anpasst, stelle ich ein paar (auch provokante) Fragen: - warum hast du gerade diese Makro rausgesucht? - hast du auch mal andere Makros hier im Forum angeschaut (Stückliste, BOM, ...)? - hast du dir die Catia-internen Möglichkeiten zur Stücklistengenerierung angeschaut? - wenn du die Unterbaugruppen auflöst, müssten dann nicht die Unterbaugruppen an sich aus der Liste verschwinden (bzw auf 0 gehen)? Sonst wäre es ja doppelt Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Esterbauer Mitglied
Beiträge: 62 Registriert: 26.09.2008
|
erstellt am: 04. Jan. 2018 12:42 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Hallo - warum hast du gerade diese Makro rausgesucht? Das Makro funktionier soweit ganz gut bis auf die Tatsache das wenn ein Produkt öfters verbaut werden die Parts nicht hochgezählt werden javascript:InsertSMI(' %20'); nur das Produkt. - hast du auch mal andere Makros hier im Forum angeschaut (Stückliste, BOM, ...)? Ja habe ich habe nichts vergleichbar gutes gefunden. - hast du dir die Catia-internen Möglichkeiten zur Stücklistengenerierung angeschaut? Ja habe mir angeschaut, da habe ich leider nicht solle Freiheiten wie mit einem Makro und kann auch ein Excel Template verwenden. - wenn du die Unterbaugruppen auflöst, müssten dann nicht die Unterbaugruppen an sich aus der Liste verschwinden (bzw auf 0 gehen)? Sonst wäre es ja doppelt. wie könnte das mit dem nicht hochzählen der Part gelöst werden ?
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 04. Jan. 2018 12:52 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus Kurze Rückfrage: was soll passieren, wenn ein Einzelteil in verschiedenen Unterbaugruppen verbaut ist (zB Schrauben)? (sieh zB auch hier) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Esterbauer Mitglied
Beiträge: 62 Registriert: 26.09.2008
|
erstellt am: 05. Jan. 2018 10:26 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Danke für dein Hilfe. Mach es jetzt ganz anders, umständlich aber es Funktioniert. Erstelle per Makro eine Catia "Bill" mit den gewünschten Informationen da öffne ich eine Standard Stückliste und lasse mir diese dann per VBA von der Catia in die Standard Stückliste übertragen. Somit habe ich nicht das mit den Produkten und die Mengenangabe stimmt auch. Danke nochmals für deine Mühen ----------------------------------------------------------------- Catia ----------------------------------------------------------------- Sub CATMain() Set productDocument1 = CATIA.ActiveDocument Set product1 = productDocument1.Product Set assemblyConvertor1 = product1.GetItem("BillOfMaterial") Dim arrayOfVariantOfBSTR2(13) arrayOfVariantOfBSTR2(0) = "Pos Nr.:" arrayOfVariantOfBSTR2(1) = "Menge" arrayOfVariantOfBSTR2(2) = "Bauteil Bezeichnung" arrayOfVariantOfBSTR2(3) = "Abmessung Länge" arrayOfVariantOfBSTR2(4) = "Abmessung Breite" arrayOfVariantOfBSTR2(5) = "Abmessung Höhe" arrayOfVariantOfBSTR2(6) = "Werkstoff" arrayOfVariantOfBSTR2(7) = "Bestellbezeichnung" arrayOfVariantOfBSTR2(8) = "Hersteller" arrayOfVariantOfBSTR2(9) = "Anmerkung" arrayOfVariantOfBSTR2(10) = "Wärmebehandlung" arrayOfVariantOfBSTR2(11) = "Oberflächenschutz" arrayOfVariantOfBSTR2(12) = "PLM Nummer" arrayOfVariantOfBSTR2(13) = "Typ"
assemblyConvertor1.SetSecondaryFormat arrayOfVariantOfBSTR2 assemblyConvertor1.Print "XLS", "C:\Users\Public\Documents\Liste.xls", product1 Set objXL = GetObject("H:\21_Standard Aufbau\Stückliste.xlsm") objXL.Application.Visible = True objXL.Parent.Windows(1).Visible = True End Sub ------------------------------------------------------------------ Ecxel ------------------------------------------------------------------ Sub Kopieren() Set Catiapart = Workbooks.Open("C:\Users\Public\Documents\Liste.xls")
'Sheets.Add After:=Sheets(Sheets.Count) Dim a As Long, i As Long Application.ScreenUpdating = False a = 1 For i = 1 To 10000 With Worksheets("Tabelle1") If .Cells(i, "N") = "Teil" Then Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 1).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 1).Value ' Pos Nr.: Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 2).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 2).Value ' Menge Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 3).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 3).Value ' Bauteil Bezeichnung Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 4).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 4).Value ' Abmessung Länge Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 5).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 5).Value ' Abmessung Breite Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 6).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 6).Value ' Abmessung Höhe Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 7).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 7).Value ' Werkstoff Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 8).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 8).Value ' Bestellbezeichnung Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 9).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 9).Value ' Anmerkung Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 10).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 10).Value ' Wärmebehandlung Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 11).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 11).Value ' Oberflächenschutz Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 12).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 12).Value ' PLM Nummer a = a + 1 Else End If End With Next i Application.ScreenUpdating = True Catiapart.Close savechanges:=False End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 05. Jan. 2018 11:23 <-- editieren / zitieren --> Unities abgeben: Nur für shoutz000
Servus Und was ist daran jetzt umständlicher als beim anderen Code? Das Kopieren und Einfügen lässt sich sicher noch optimieren. (ggf mit .Rang.Copy oder .Cell.Copy) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |