| |
| ISD präsentiert innovative Features auf der ACHEMA, eine Pressemitteilung
|
Autor
|
Thema: HiCAD 2012 Stücklisten VBS anpassen (3048 mal gelesen)
|
Flixer Moderator Dipl. Ing. MaschBau
Beiträge: 311 Registriert: 16.06.2006 Core i5 4670 8GB DDR-3 1600MHz GTX 760Ti Samsung SSD Evo mit 120GB
|
erstellt am: 10. Sep. 2012 12:32 <-- editieren / zitieren --> Unities abgeben:
Hallo, wir sind seit ein paar Tagen auf HiCAD 2012 umgestiegen. Die automatische Stücklistengenerierung habe ich angepasst, doch unser Werkstattmeister möchte noch etwas "besonderes". Auf der Strukturliste sollen alle Baugruppen (also die komplette Zeile in der irgentwo Baugruppe XYZ steht) fett hervor gehoben werden. Das VBA war kinderleicht (Makro aufzeichnen -> durchführen -> fertig.). Das VBS erweist sich als sehr schwierig. Ich habe mal in den Anhang meine angepasste VBS gepackt, welche wir für unsere Stücklisten nutzen wollen. Das ganze ist ein RAR Archiv und ich habe nur den Anhang in TXT geändert. Vielleicht kann da mal einer drauf schaun. Der heikle Bereich liegt in den Zeilen 415 bis 428 und ist momentan deaktiviert. Hier der Code: Dim wsStruct Dim Such, Treffer1 set wsStruct = objExcel.Worksheets("strukturliste") Set Such = wsStruct.Cells.Find("Baugruppe", wsStruct.Range("A1"), -4163, 2) Set Such = wsStruct.Cells.Find("Baugruppe") Set Such = wsStruct.Cells.Find("Baugruppe", , , 2) Set Such = wsStruct.Cells.Find("Baugruppe", lookat:=xlPart) If Not Such Is Nothing Then Treffer1 = Such.Address Do Rows(Such.Row).Font.Bold = True Set Such = Cells.FindNext(Such) Loop While Not Such Is Nothing And Treffer1 <> Such.Address End If Von den "Set Such" habe 4 Versionen. Keine funktioniert... MfG Flixer Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Flixer Moderator Dipl. Ing. MaschBau
Beiträge: 311 Registriert: 16.06.2006 Core i5 4670 8GB DDR-3 1600MHz GTX 760Ti Samsung SSD Evo mit 120GB
|
erstellt am: 25. Okt. 2012 12:08 <-- editieren / zitieren --> Unities abgeben:
Als Info: Ich habe eine Lösung für das Suchen von bestimmten Namen in einer bestimmten Liste, das Markieren dieser und die Möglichkeit Zeilen farbliche hervorzuheben entwickelt. Damit kann das VBS komplette Stücklisten erstellen und diese nach Mustern anpassen. MfG Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADLUIS Mitglied
Beiträge: 278 Registriert: 31.01.2008 HP Workstation Z840, NVIDIA Quadro 4200, WIN7, HICAD 2017
|
erstellt am: 27. Okt. 2012 08:55 <-- editieren / zitieren --> Unities abgeben: Nur für Flixer
|
Flixer Moderator Dipl. Ing. MaschBau
Beiträge: 311 Registriert: 16.06.2006 Core i5 4670 8GB DDR-3 1600MHz GTX 760Ti Samsung SSD Evo mit 120GB
|
erstellt am: 28. Okt. 2012 11:05 <-- editieren / zitieren --> Unities abgeben:
Hallo CADLUIS, also die Lösung ist in meinem Kopf und bei uns an den Arbeitsstationen. Leider gab es keine weiteren Personen, die sich an der Hilfestellung beteiligt haben. Ich habe mühsam diverse Anfragen und Diskussionen in VBS Foren geführt und bin durch probieren auf die Lösung gekommen. In der Hoffnung das bei weiteren Problemen meinerseits ebenso Hilfe angeboten wird und vielleicht eine gemeinsame Lösung gefunden werden kann bin ich jetzt mal so freundlich und schreibe die Lösung hier hin. Der unterste Block (bei uns ab Zeile 443) sieht so aus: ---------BEGIN CODE----------- 'Strukturliste MaxCrit = 0 CreateBOM "Strukturliste" , "Structure_List" , "%KrpModul" , False objExcel.Cells(2,2).Value = ISDGetText("Strukturliste") objExcel.Cells(3,2).Value = ISDGetText("generiert am:") objExcel.Cells(3,3).Value = Date objExcel.Worksheets(MySheetName1).PageSetup.PrintArea = "A:L" Dim wsStruct Dim Such, Treffer1 set wsStruct = objExcel.Worksheets("strukturliste") Set Such = wsStruct.Cells.Find("Baugruppe") If Not Such Is Nothing Then Treffer1 = Such.Address Do Such.EntireRow.Font.Bold = True Such.EntireRow.Interior.Color = RGB(220,220,220) Set Such = wsStruct.Cells.FindNext(Such) Loop While Not Such Is Nothing And Treffer1 <> Such.Address End If ---------END CODE----------- Viel Glück beim Anpassen. TIP: Wenn man die Makros von Excel etwas anpasst und weiß welche Struktur für VBS nötig ist, können weitere Anpassungen vorgenommen werden (Schriftgröße, Farbe, Zellenformatierung etc.). MfG Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADLUIS Mitglied
Beiträge: 278 Registriert: 31.01.2008 HP Workstation Z840, NVIDIA Quadro 4200, WIN7, HICAD 2017
|
erstellt am: 28. Okt. 2012 14:02 <-- editieren / zitieren --> Unities abgeben: Nur für Flixer
|
CADLUIS Mitglied
Beiträge: 278 Registriert: 31.01.2008 HP Workstation Z840, NVIDIA Quadro 4200, WIN7, HICAD 2017
|
erstellt am: 17. Dez. 2013 05:30 <-- editieren / zitieren --> Unities abgeben: Nur für Flixer
|
Flixer Moderator Dipl. Ing. MaschBau
Beiträge: 311 Registriert: 16.06.2006 Core i5 4670 8GB DDR-3 1600MHz GTX 760Ti Samsung SSD Evo mit 120GB
|
erstellt am: 17. Dez. 2013 07:24 <-- editieren / zitieren --> Unities abgeben:
Hallo Alois, das Problem habe ich behoben bzw. eine Lösung gefunden. Einzig die Fläche der Baugruppen fehlt uns noch. Der Rest befindet sich jetzt in einem, für unseren Meister, akzeptablem Zustand. Es wäre toll wenn du noch weitere Lösugnen für Anpassungen anbieten könntest. MfG Flixer Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADLUIS Mitglied
Beiträge: 278 Registriert: 31.01.2008 HP Workstation Z840, NVIDIA Quadro 4200, WIN7, HICAD 2017
|
erstellt am: 17. Dez. 2013 08:28 <-- editieren / zitieren --> Unities abgeben: Nur für Flixer
Hallo Flixer, bzgl. Oberfläche bin ich auch noch am werken habe zwar einen Weg aber die Syntax ... meine Variante mit zus. Leerzeile nach der BG
Dim wsStruct1 Dim Such1, Treffer1 set wsStruct1 = objExcel.Worksheets("Baugruppenliste") Set Such1 = wsStruct1.Columns("C").Find("Baugruppe") If Not Such1 Is Nothing Then Such1.EntireRow.Insert Treffer1 = Such1.Address Do Such1.EntireRow.Font.Bold = True Such1.EntireRow.Interior.Color = RGB(235,235,235) Set Such1 = wsStruct1.Columns("C").FindNext(Such1) if not Such1 is nothing And Treffer1 <> Such1.Address then Such1.EntireRow.Insert end if Loop While Not Such1 Is Nothing And Treffer1 <> Such1.Address End If
grüße
Alois Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Flixer Moderator Dipl. Ing. MaschBau
Beiträge: 311 Registriert: 16.06.2006 Core i5 4670 8GB DDR-3 1600MHz GTX 760Ti Samsung SSD Evo mit 120GB
|
erstellt am: 17. Dez. 2013 08:40 <-- editieren / zitieren --> Unities abgeben:
|
CADLUIS Mitglied
Beiträge: 278 Registriert: 31.01.2008 HP Workstation Z840, NVIDIA Quadro 4200, WIN7, HICAD 2017
|
erstellt am: 10. Jan. 2014 20:09 <-- editieren / zitieren --> Unities abgeben: Nur für Flixer
|