| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | | | | Request a special discount on NVIDIA RTX 5000 Ada Generation GPU !, eine Pressemitteilung
|
Autor
|
Thema: Fehler im VBA Code beim Erstellen der Excel-Stückliste (1713 / mal gelesen)
|
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 07. Okt. 2021 13:19 <-- editieren / zitieren --> Unities abgeben:
Hallo zusammen, ich habe einen VBA-Code um die Stückliste aus Inventor in eine Exceltabelle zu überführen.
Code:
Public Sub btn_test_Click() ' Set a reference to the assembly document. ' This assumes an assembly document is active. Dim oDoc As AssemblyDocument Set oDoc = ThisApplication.ActiveDocument Dim FirstLevelOnly As Boolean If MsgBox("First level only?", vbYesNo) = vbYes Then FirstLevelOnly = True Else FirstLevelOnly = False End If ' Set a reference to the BOM Dim oBOM As BOM Set oBOM = oDoc.ComponentDefinition.BOM ' Set whether first level only or all levels. If FirstLevelOnly Then oBOM.StructuredViewFirstLevelOnly = True Else oBOM.StructuredViewFirstLevelOnly = False End If ' Make sure that the structured view is enabled. oBOM.StructuredViewEnabled = True 'Set a reference to the "Structured" BOMView Dim oBOMView As BOMView Set oBOMView = oBOM.BOMViews.Item("Strukturiert") Debug.Print "Item"; Tab(15); "Quantity"; Tab(30); "Part Number"; Tab(70); "Description" Debug.Print "----------------------------------------------------------------------------------" '-> initialize Array für Header (Kopfzeile) Dim sHeaderCSV(1) As String sHeaderCSV(0) = "Stock Number; Part Number; Item; Quantity; Description" sHeaderCSV(1) = "----------------------------------------------------------------------------------" '-> init Array mit Listeneinträgen ReDim gaStr_CSV(0) 'Initialize the tab for ItemNumber Dim ItemTab As Long ItemTab = -3 'Elemente der BOM durcharbeiten, rekursiv Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab) '-> Array mit den BOM-Einträgen sortieren 'Call QuickSort_s(gaStr_CSV) Call QuickSort(gaStr_CSV) 'gibt es Unterschiede im Ergebnis der beiden Algorithmen? '-> Datei schreiben Dim str_CSVdatei As String str_CSVdatei = "C:\temp\Test.csv" Call Write2File(str_CSVdatei, gaStr_CSV, sHeaderCSV) '-> Datei öffnen Dim ws As Object Set ws = CreateObject("WScript.Shell") 'Umweg, weil ich es mit dem integrierten Shell-Befehl nicht geschafft hab ws.Run Chr(34) & str_CSVdatei & Chr(34) 'öffnet die geschriebene Datei mit der in Windows zugeordneten Anwendung 'Stueckliste in Zeilen nach Nummerierung sortieren Worksheets("Test").Sort.SortFields.Clear Worksheets("Test").Sort.SortFields.Add2 Key:=Range("C3:C73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Test").Sort .SetRange Range("A3:E73") .header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Spalten in Stueckliste sortieren 'Position Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("D:D").Cut Destination:=Columns("A:A") 'Menge Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("F:F").Cut Destination:=Columns("B:B") 'Einheit Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("C1").Value = "Einheit" 'Benennung Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("I:I").Cut Destination:=Columns("D:D") 'Zeichnungsnummer Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("G:G").Cut Destination:=Columns("E:E") 'Bemerkung ist jetzt bereits an korrekter Stelle Set ws = Nothing 'Aufräumen End Sub
Das funktioniert auch alles sehr gut bis zu dieser Zeile Code:
'Stueckliste in Zeilen nach Nummerierung sortieren Worksheets("Test").Sort.SortFields.Clear
Dort meldet er mir folgendes: Compile error: Sub or Function not defined Ich stehe momentan auf der Leitung wieso das nicht funktionieren will? Weiß jemand einen Rat? Viele Grüße ------------------
Du bist die Aufgabe - Franz Kafka Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
BernoAn Mitglied
Beiträge: 172 Registriert: 16.01.2014
|
erstellt am: 07. Okt. 2021 13:40 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
Hallo, Wenn er bei der Zeile "clear" die du angegeben hast aussteigt ist komisch bei mir läuft die Zeile poblemlos. Aber in der Zeile darunter ist mal ein Fehler denke ich, die Zahl "2" muss bei add weg.
Code:
'Stueckliste in Zeilen nach Nummerierung sortieren Worksheets("Test").Sort.SortFields.Clear Worksheets("Test").Sort.SortFields.Add2 Key:=Range("C3:C73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
neu Code:
'Stueckliste in Zeilen nach Nummerierung sortieren Worksheets("Test").Sort.SortFields.Clear Worksheets("Test").Sort.SortFields.Add Key:=Range("C3:C73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Gruß Berno
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 13. Okt. 2021 16:17 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von BernoAn: Wenn er bei der Zeile "clear" die du angegeben hast aussteigt ist komisch bei mir läuft die Zeile poblemlos.Aber in der Zeile darunter ist mal ein Fehler denke ich, die Zahl "2" muss bei add weg.
Danke für den Hinweis. Ich habe die Zahl "2" bei add entfernt und er steigt weiterhin an besagter Stelle bei "clear" aus. Habe die Zahl "2" dann wieder hinzugefügt, weil es keine Veränderung brachte.
Ich habe den Code in Excel mit dem Makrorekorder erzeugt, angepasst und dann in Excel nochmal durchlaufen lassen. In Excel funktioniert dieser Code auch problemlos, aber nachdem ich ihn im Inventor in den VBA-Editor eingefügt habe und dort durchlaufen lassen wollte, kam es eben zu diesem Fehler. Ich bitte nochmal um Rat bei der Fehlersuche. ------------------
Du bist die Aufgabe - Franz Kafka Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 13. Okt. 2021 23:30 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
Hallo Da fehlt ein Teil. Normalerweise startet man vorher eine Excelinstanz, öffnet die Datei und weist das ActiveWorkBook einer Variable (z.B. oWB) zu. Dann kann man mit
Code: oWB.WorkSheets("Test")
auf das Tabellenblatt zugreifen. Mit dem von Windows Scripting erzeugten Object "ws" hast du wahrscheinlich auch das Problem, das Eigenschaften wie "WorkSheets" dort schlicht nicht existieren.
Code: Option Explicit ' ########################################################### ' ########################################################### ' Requires reference to Microsoft Excel XX.0 Object Library ! ' (XX is twhe internal version number of the installed Excel) ' ########################################################### ' ###########################################################
Public Sub btn_test_Click() ' Set a reference to the assembly document. ' This assumes an assembly document is active. Dim oDoc As AssemblyDocument Set oDoc = ThisApplication.ActiveDocument
Dim FirstLevelOnly As Boolean If MsgBox("First level only?", vbYesNo) = vbYes Then FirstLevelOnly = True Else FirstLevelOnly = False End If ' Set a reference to the BOM Dim oBOM As BOM Set oBOM = oDoc.ComponentDefinition.BOM ' Set whether first level only or all levels. If FirstLevelOnly Then oBOM.StructuredViewFirstLevelOnly = True Else oBOM.StructuredViewFirstLevelOnly = False End If ' Make sure that the structured view is enabled. oBOM.StructuredViewEnabled = True 'Set a reference to the "Structured" BOMView Dim oBOMView As BOMView Set oBOMView = oBOM.BOMViews.Item("Strukturiert") Debug.Print "Item"; Tab(15); "Quantity"; Tab(30); "Part Number"; Tab(70); "Description" Debug.Print "----------------------------------------------------------------------------------" '-> initialize Array für Header (Kopfzeile) Dim sHeaderCSV(1) As String sHeaderCSV(0) = "Stock Number; Part Number; Item; Quantity; Description" sHeaderCSV(1) = "----------------------------------------------------------------------------------" '-> init Array mit Listeneinträgen ReDim gaStr_CSV(0) 'Initialize the tab for ItemNumber Dim ItemTab As Long ItemTab = -3 'Elemente der BOM durcharbeiten, rekursiv Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab) '-> Array mit den BOM-Einträgen sortieren 'Call QuickSort_s(gaStr_CSV) Call QuickSort(gaStr_CSV) 'gibt es Unterschiede im Ergebnis der beiden Algorithmen? '-> Datei schreiben Dim str_CSVdatei As String str_CSVdatei = "C:\temp\Test.csv" Call Write2File(str_CSVdatei, gaStr_CSV, sHeaderCSV) '-> Datei öffnen 'Dim ws As Object 'Set ws = CreateObject("WScript.Shell") 'Umweg, weil ich es mit dem integrierten Shell-Befehl nicht geschafft hab 'ws.Run Chr(34) & str_CSVdatei & Chr(34) 'öffnet die geschriebene Datei mit der in Windows zugeordneten Anwendung Dim oExcelApp As Excel.Application Set oExcelApp = GetObject("", "Excel.Application") If oExcelApp Is Nothing Then MsgBox ("Can't get Excel") Exit Sub End If Dim oWB As Workbook Set oWB = oExcelApp.Workbooks.Open(str_CSVdatei) If Not oWB Is Nothing Then Dim oWS As WorkSheet Set oWS = oWB.Worksheets("Test") 'Stueckliste in Zeilen nach Nummerierung sortieren oWS.Sort.SortFields.Clear oWS.Sort.SortFields.Add2 Key:=Range("C3:C73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With oWS.Sort .SetRange Range("A3:E73") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Spalten in Stueckliste sortieren 'Position oWS.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("D:D").Cut Destination:=Columns("A:A") 'Menge oWS.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("F:F").Cut Destination:=Columns("B:B") 'Einheit oWS.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Range("C1").Value = "Einheit" 'Benennung oWS.Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("I:I").Cut Destination:=Columns("D:D") 'Zeichnungsnummer oWS.Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("G:G").Cut Destination:=Columns("E:E") 'Bemerkung ist jetzt bereits an korrekter Stelle 'Set ws = Nothing 'Aufräumen End Sub
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 15. Okt. 2021 10:24 <-- editieren / zitieren --> Unities abgeben:
Danke für die Rückmeldung. Ich bekomme nun allerdings eine Fehlermeldung bei der Deklarierung der Excel-Variable: Compile error: User-defined type not defined Wie definiere ich diesen Variablentyp Excel.Application in Inventor nun korrekt? Mir fiel auch noch dieser Hinweis auf
Code: ' ########################################################### ' ########################################################### ' Requires reference to Microsoft Excel XX.0 Object Library ! ' (XX is twhe internal version number of the installed Excel) ' ########################################################### ' ###########################################################
Ich kann allerdings nirgendwo in dem von dir geposteten Code eine Stelle finden, wo ich die Excel Version definieren müßte. An der Stelle sei auch noch erwähnt, daß bei meinem Arbeitgeber auf den PCs meiner Kollegen zum Teil unterschiedliche Excel Versionen laufen. Ich hoffe, das ist kein Hinderungsgrund? ------------------
Du bist die Aufgabe - Franz Kafka Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 15. Okt. 2021 10:59 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
Hallo Wenn du den VBA-Editor offen hast: - Menü "Extras" --> "Verweise" anklicken - im Auswahldialog nach dem Eintrag "Microsoft Excel XX.0 Object Library" suchen und aktivieren Das musst du einmalig auf jedem Rechner machen. Das XX ist die jeweilige Excel Versionsnummer. Ich hoffe ihr habt kein Office365 in der Webvariante im Einsatz. Damit funktioniert es mines Wissens nicht. ------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 15. Okt. 2021 11:14 <-- editieren / zitieren --> Unities abgeben:
Danke für den Hinweis. Seltsamerweise gibt es den Menüpunkt Extras bei mir gar nicht Wie aktiviere ich den Eintrag "Microsoft Excel XX.0 Object Library" nun trotzdem aktivieren? Ich habe mich im VBA-Editor durchs Menü gesucht und leider nichts finden können. Office365 haben wir zum Glück nicht. ------------------
Du bist die Aufgabe - Franz Kafka Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 15. Okt. 2021 11:25 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
|
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 15. Okt. 2021 13:55 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von rkauskh: Hallo Sag doch gleich dass du die englische Version hast. Da heißt das "Tools" --> "References"
Ach ja, References...hätte ich auch selber drauf kommen können. Ich Depp... Der Code läuft jetzt soweit durch, aber ich bekomme gerade eine Fehlermeldung, die mich ratlos macht
Code: Dim oWB As Workbook Set oWB = oExcelApp.Workbooks.Open(str_CSVdatei) If Not oWB Is Nothing Then Dim oWS As WorkSheet Set oWS = oWB.Worksheets("Test") '''''int_letztezeile = Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Row 'Stueckliste in Zeilen nach Nummerierung sortieren oWS.Sort.SortFields.Clear oWS.Sort.SortFields.Add2 Key:=Range("C3:C73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With oWS.Sort .SetRange Range("A3:E73") .header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Spalten in Stueckliste sortieren 'Position oWS.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("D:D").Cut Destination:=Columns("A:A") 'Menge oWS.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("F:F").Cut Destination:=Columns("B:B") 'Einheit oWS.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Range("C1").Value = "Einheit" oWS.Range("C3").Value = "Stück" oWS.Range("C3").AutoFill Destination:=Range("C3:C" & int_letztezeile), Type:=xlFillDefault 'Benennung oWS.Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("I:I").Cut Destination:=Columns("D:D") 'Zeichnungsnummer oWS.Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("G:G").Cut Destination:=Columns("E:E") 'Bemerkung 'bereits an korrekter Stelle End If
Wo steckt hier der Fehler? ------------------
Du bist die Aufgabe - Franz Kafka Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 15. Okt. 2021 19:13 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
Hallo Höchstwahrscheinlich läuft da noch mindestens eine Excelinstanz im Hintergrund? Beende mal alle laufenden Excel Instanzen. Falls nicht sichtbar, die Excel.exe im Taskmanager abschießen. In deinem Code fehlen am Ende zwei Möglichkeiten. Ich war davon ausgegangen das das nur nicht mitkopiert wurde. Entweder machst du mit Code: oExcelApp.Visible=true
dein Excel mitsamt der geöffneten Datei sichtbar und kümmerst dich selbst ums Speichern und Schließen oder wenn es unsichtbar bleiben soll, die Datei speichern und schließen und wenn sonst keine Dateien mehr offen sind die Excelinstanz beenden mit Code:
oWB.Save oWB.CloseIf oExcelApp.Workbooks.Count = 0 Then oExcelApp.Quit End If
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 20. Okt. 2021 10:52 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von rkauskh: Höchstwahrscheinlich läuft da noch mindestens eine Excelinstanz im Hintergrund? Beende mal alle laufenden Excel Instanzen. Falls nicht sichtbar, die Excel.exe im Taskmanager abschießen.
Stimmt, da liefen im Hintergrund noch weitere Excelinstanzen. Jetzt geht es. Jetzt habe ich aber ein Problem, das vorher irgendwie nicht auftauchte.😒🤷♂️
Ich poste nochmal meinen aktuellen Code, in der Hoffnung, daß da wirklich nichts fehlt. Bin für jeden Hinweis dankbar.
Code: Public Sub btn_test_Click() Dim int_letztezeile As Integer ' Set a reference to the assembly document. ' This assumes an assembly document is active. Dim oDoc As AssemblyDocument Set oDoc = ThisApplication.ActiveDocument Dim FirstLevelOnly As Boolean If MsgBox("First level only?", vbYesNo) = vbYes Then FirstLevelOnly = True Else FirstLevelOnly = False End If ' Set a reference to the BOM Dim oBOM As BOM Set oBOM = oDoc.ComponentDefinition.BOM ' Set whether first level only or all levels. If FirstLevelOnly Then oBOM.StructuredViewFirstLevelOnly = True Else oBOM.StructuredViewFirstLevelOnly = False End If ' Make sure that the structured view is enabled. oBOM.StructuredViewEnabled = True 'Set a reference to the "Structured" BOMView Dim oBOMView As BOMView Set oBOMView = oBOM.BOMViews.Item("Strukturiert") Debug.Print "Item"; Tab(15); "Quantity"; Tab(30); "Part Number"; Tab(70); "Description" Debug.Print "----------------------------------------------------------------------------------" '-> initialize Array für Header (Kopfzeile) Dim sHeaderCSV(1) As String sHeaderCSV(0) = "Stock Number; Part Number; Item; Quantity; Description" sHeaderCSV(1) = "----------------------------------------------------------------------------------" '-> init Array mit Listeneinträgen ReDim gaStr_CSV(0) 'Initialize the tab for ItemNumber Dim ItemTab As Long ItemTab = -3 'Elemente der BOM durcharbeiten, rekursiv Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab) '-> Array mit den BOM-Einträgen sortieren 'Call QuickSort_s(gaStr_CSV) Call QuickSort(gaStr_CSV) 'gibt es Unterschiede im Ergebnis der beiden Algorithmen? '-> Datei schreiben Dim str_CSVdatei As String str_CSVdatei = "C:\temp\Test.csv" Call Write2File(str_CSVdatei, gaStr_CSV, sHeaderCSV) '-> Datei öffnen Dim ws As Object Set ws = CreateObject("WScript.Shell") 'Umweg, weil ich es mit dem integrierten Shell-Befehl nicht geschafft hab ws.Run Chr(34) & str_CSVdatei & Chr(34) 'öffnet die geschriebene Datei mit der in Windows zugeordneten Anwendung 'Prüfen ob Excel vorhanden ist Dim oExcelApp As Excel.Application Set oExcelApp = GetObject("", "Excel.Application") If oExcelApp Is Nothing Then MsgBox ("Can't get Excel") Exit Sub End If Dim oWB As Workbook Set oWB = oExcelApp.Workbooks.Open(str_CSVdatei) 'Eventuell noch offene Instanzen schließen oWB.Save oWB.Close If oExcelApp.Workbooks.Count = 0 Then oExcelApp.Quit End If If Not oWB Is Nothing Then Dim oWS As WorkSheet Set oWS = oWB.Worksheets("Test") '''''int_letztezeile = Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Row 'Stueckliste in Zeilen nach Nummerierung sortieren oWS.Sort.SortFields.Clear oWS.Sort.SortFields.Add2 Key:=Range("C3:C73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With oWS.Sort .SetRange Range("A3:E73") .header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Spalten in Stueckliste sortieren 'Position oWS.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("D:D").Cut Destination:=Columns("A:A") 'Menge oWS.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("F:F").Cut Destination:=Columns("B:B") 'Einheit oWS.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Range("C1").Value = "Einheit" oWS.Range("C3").Value = "Stück" 'oWS.Range("C3").AutoFill Destination:=Range("C3:C" & int_letztezeile), Type:=xlFillDefault 'Benennung oWS.Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("I:I").Cut Destination:=Columns("D:D") 'Zeichnungsnummer oWS.Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("G:G").Cut Destination:=Columns("E:E") 'Bemerkung 'bereits an korrekter Stelle End If Set ws = Nothing 'Aufräumen End Sub
------------------
Du bist die Aufgabe - Franz Kafka Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 20. Okt. 2021 20:21 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
Hallo Ich glaub es fehlt nix, aber die Reihenfolge halte ich für suboptimal. Code:
Dim oWB As Workbook Set oWB = oExcelApp.Workbooks.Open(str_CSVdatei) 'Eventuell noch offene Instanzen schließen oWB.Save oWB.Close If oExcelApp.Workbooks.Count = 0 Then oExcelApp.Quit End If If Not oWB Is Nothing Then Dim oWS As WorkSheet
Du öffnest die CSV-Datei. Du speicherst sie. Du schließt sie. Du beendest Excel. oWB ist vom GarbageCollector noch nicht bereinigt worden, sollte also noch existieren. Daher greift deine If Not oWB is Nothing nicht. Das Zuweisen von oWS schlägt trotzdem fehl, da oWB vermutlich in irgendeinem undefinierten Zustand ist. Probier mal in der Reihenfolge: Code:
Public Sub btn_test_Click() Dim int_letztezeile As Integer ' Set a reference to the assembly document. ' This assumes an assembly document is active. Dim oDoc As AssemblyDocument Set oDoc = ThisApplication.ActiveDocument Dim FirstLevelOnly As Boolean If MsgBox("First level only?", vbYesNo) = vbYes Then FirstLevelOnly = True Else FirstLevelOnly = False End If ' Set a reference to the BOM Dim oBOM As BOM Set oBOM = oDoc.ComponentDefinition.BOM ' Set whether first level only or all levels. If FirstLevelOnly Then oBOM.StructuredViewFirstLevelOnly = True Else oBOM.StructuredViewFirstLevelOnly = False End If ' Make sure that the structured view is enabled. oBOM.StructuredViewEnabled = True 'Set a reference to the "Structured" BOMView Dim oBOMView As BOMView Set oBOMView = oBOM.BOMViews.Item("Strukturiert") Debug.Print "Item"; Tab(15); "Quantity"; Tab(30); "Part Number"; Tab(70); "Description" Debug.Print "----------------------------------------------------------------------------------" '-> initialize Array für Header (Kopfzeile) Dim sHeaderCSV(1) As String sHeaderCSV(0) = "Stock Number; Part Number; Item; Quantity; Description" sHeaderCSV(1) = "----------------------------------------------------------------------------------" '-> init Array mit Listeneinträgen ReDim gaStr_CSV(0) 'Initialize the tab for ItemNumber Dim ItemTab As Long ItemTab = -3 'Elemente der BOM durcharbeiten, rekursiv Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab) '-> Array mit den BOM-Einträgen sortieren 'Call QuickSort_s(gaStr_CSV) Call QuickSort(gaStr_CSV) 'gibt es Unterschiede im Ergebnis der beiden Algorithmen? '-> Datei schreiben Dim str_CSVdatei As String str_CSVdatei = "C:\temp\Test.csv" Call Write2File(str_CSVdatei, gaStr_CSV, sHeaderCSV) '-> Datei öffnen Dim ws As Object Set ws = CreateObject("WScript.Shell") 'Umweg, weil ich es mit dem integrierten Shell-Befehl nicht geschafft hab ws.Run Chr(34) & str_CSVdatei & Chr(34) 'öffnet die geschriebene Datei mit der in Windows zugeordneten Anwendung 'Prüfen ob Excel vorhanden ist Dim oExcelApp As Excel.Application Set oExcelApp = GetObject("", "Excel.Application") If oExcelApp Is Nothing Then MsgBox ("Can't get Excel") Exit Sub End If Dim oWB As Workbook Set oWB = oExcelApp.Workbooks.Open(str_CSVdatei) If Not oWB Is Nothing Then Dim oWS As WorkSheet Set oWS = oWB.Worksheets("Test") '''''int_letztezeile = Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Row 'Stueckliste in Zeilen nach Nummerierung sortieren oWS.Sort.SortFields.Clear oWS.Sort.SortFields.Add2 Key:=Range("C3:C73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With oWS.Sort .SetRange Range("A3:E73") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Spalten in Stueckliste sortieren 'Position oWS.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("D:D").Cut Destination:=Columns("A:A") 'Menge oWS.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("F:F").Cut Destination:=Columns("B:B") 'Einheit oWS.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Range("C1").Value = "Einheit" oWS.Range("C3").Value = "Stück" 'oWS.Range("C3").AutoFill Destination:=Range("C3:C" & int_letztezeile), Type:=xlFillDefault 'Benennung oWS.Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("I:I").Cut Destination:=Columns("D:D") 'Zeichnungsnummer oWS.Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("G:G").Cut Destination:=Columns("E:E") 'Bemerkung 'bereits an korrekter Stelle End If 'Aufräumen Set ws = Nothing 'Eventuell noch offene Instanzen schließen oWB.Save oWB.Close If oExcelApp.Workbooks.Count = 0 Then oExcelApp.Quit End If End Sub
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 26. Okt. 2021 11:53 <-- editieren / zitieren --> Unities abgeben:
Besten Dank für deine Hilfe, doch ich verstehe einfach nicht, weshalb es bei mir nicht laufen will. Und ich habe festgestellt, daß ich dir einen Teil des Programmscodes unbeabsichtigt vorenthalten habe. Entschuldigung. Hier jetzt der ganze Code. Code: Public Sub btn_test_Click() Dim int_letztezeile As Integer Dim oWB As Workbook Dim oExcelApp As Excel.Application' Set a reference to the assembly document. ' This assumes an assembly document is active. Dim oDoc As AssemblyDocument Set oDoc = ThisApplication.ActiveDocument Dim FirstLevelOnly As Boolean If MsgBox("First level only?", vbYesNo) = vbYes Then FirstLevelOnly = True Else FirstLevelOnly = False End If ' Set a reference to the BOM Dim oBOM As BOM Set oBOM = oDoc.ComponentDefinition.BOM ' Set whether first level only or all levels. If FirstLevelOnly Then oBOM.StructuredViewFirstLevelOnly = True Else oBOM.StructuredViewFirstLevelOnly = False End If ' Make sure that the structured view is enabled. oBOM.StructuredViewEnabled = True 'Set a reference to the "Structured" BOMView Dim oBOMView As BOMView Set oBOMView = oBOM.BOMViews.Item("Strukturiert") Debug.Print "Item"; Tab(15); "Quantity"; Tab(30); "Part Number"; Tab(70); "Description" Debug.Print "----------------------------------------------------------------------------------" '-> initialize Array für Header (Kopfzeile) Dim sHeaderCSV(1) As String sHeaderCSV(0) = "Stock Number; Part Number; Item; Quantity; Description" sHeaderCSV(1) = "----------------------------------------------------------------------------------" '-> init Array mit Listeneinträgen ReDim gaStr_CSV(0) 'Initialize the tab for ItemNumber Dim ItemTab As Long ItemTab = -3 'Elemente der BOM durcharbeiten, rekursiv Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab) '-> Array mit den BOM-Einträgen sortieren 'Call QuickSort_s(gaStr_CSV) Call QuickSort(gaStr_CSV) 'gibt es Unterschiede im Ergebnis der beiden Algorithmen? '-> Datei schreiben Dim str_CSVdatei As String str_CSVdatei = "C:\temp\Test.csv" Call Write2File(str_CSVdatei, gaStr_CSV, sHeaderCSV) '-> Datei öffnen Dim ws As Object Set ws = CreateObject("WScript.Shell") 'Umweg, weil ich es mit dem integrierten Shell-Befehl nicht geschafft hab ws.Run Chr(34) & str_CSVdatei & Chr(34) 'öffnet die geschriebene Datei mit der in Windows zugeordneten Anwendung 'Prüfen ob Excel vorhanden ist Set oExcelApp = GetObject("", "Excel.Application") If oExcelApp Is Nothing Then MsgBox ("Can't get Excel") Exit Sub End If Set oWB = oExcelApp.Workbooks.Open(str_CSVdatei) If Not oWB Is Nothing Then Dim oWS As WorkSheet Set oWS = oWB.Worksheets("Test") '''''int_letztezeile = Sheets("Test").Cells(Rows.Count, 1).End(xlUp).Row 'Stueckliste in Zeilen nach Nummerierung sortieren oWS.Sort.SortFields.Clear oWS.Sort.SortFields.Add2 Key:=Range("C3:C73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With oWS.Sort .SetRange Range("A3:E73") .header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Spalten in Stueckliste sortieren 'Position oWS.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("D:D").Cut Destination:=Columns("A:A") 'Menge oWS.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("F:F").Cut Destination:=Columns("B:B") 'Einheit oWS.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Range("C1").Value = "Einheit" oWS.Range("C3").Value = "Stück" 'oWS.Range("C3").AutoFill Destination:=Range("C3:C" & int_letztezeile), Type:=xlFillDefault 'Benennung oWS.Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("I:I").Cut Destination:=Columns("D:D") 'Zeichnungsnummer oWS.Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove oWS.Columns("G:G").Cut Destination:=Columns("E:E") 'Bemerkung 'bereits an korrekter Stelle End If 'Aufräumen Set ws = Nothing 'Eventuell noch offene Instanzen schließen oWB.Save oWB.Close If oExcelApp.Workbooks.Count = 0 Then oExcelApp.Quit End If End Sub Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, ItemTab As Long) ItemTab = ItemTab + 3 ' Iterate through the contents of the BOM Rows. Dim i As Long For i = 1 To oBOMRows.Count ' Get the current row. Dim oRow As BOMRow Set oRow = oBOMRows.Item(i) 'Set a reference to the primary ComponentDefinition of the row Dim oCompDef As ComponentDefinition Set oCompDef = oRow.ComponentDefinitions.Item(1) Dim oPartNumProperty As Property Dim oDescripProperty As Property '-> hinzu Property "Bestandsnummer" Dim oStockNoProp As Property If TypeOf oCompDef Is VirtualComponentDefinition Then 'Get the file property that contains the "Part Number" 'The file property is obtained from the virtual component definition Set oPartNumProperty = oCompDef.PropertySets _ .Item("Design Tracking Properties").Item("Part Number") 'Get the file property that contains the "Description" Set oDescripProperty = oCompDef.PropertySets _ .Item("Design Tracking Properties").Item("Description") Debug.Print Tab(ItemTab); oRow.ItemNumber; Tab(17); oRow.ItemQuantity; Tab(30); _ oPartNumProperty.Value; Tab(70); oDescripProperty.Value ' -> hinzu Set oStockNoProp = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Stock Number") Call writeLine2Array(oStockNoProp.Value & ";" & oPartNumProperty.Value & ";" & oRow.ItemNumber & ";" _ & oRow.ItemQuantity & ";" & oDescripProperty.Value) Else 'Get the file property that contains the "Part Number" 'The file property is obtained from the parent 'document of the associated ComponentDefinition. Set oPartNumProperty = oCompDef.Document.PropertySets _ .Item("Design Tracking Properties").Item("Part Number") 'Get the file property that contains the "Description" Set oDescripProperty = oCompDef.Document.PropertySets _ .Item("Design Tracking Properties").Item("Description") Debug.Print Tab(ItemTab); oRow.ItemNumber; Tab(17); oRow.ItemQuantity; Tab(30); _ oPartNumProperty.Value; Tab(70); oDescripProperty.Value '-> hinzu Set oStockNoProp = oCompDef.Document.PropertySets _ .Item("Design Tracking Properties").Item("Stock Number") Call writeLine2Array(oStockNoProp.Value & ";" & oPartNumProperty.Value & ";" & oRow.ItemNumber & ";" _ & oRow.ItemQuantity & ";" & oDescripProperty.Value) 'Recursively iterate child rows if present. If Not oRow.ChildRows Is Nothing Then Call QueryBOMRowProperties(oRow.ChildRows, ItemTab) End If End If Next ItemTab = ItemTab - 3 End Sub Private Sub Write2File(strFile As String, ByRef strData() As String, ByRef strHeader() As String) 'Schreibt den Inhalt eines Strings in eine neue Datei Dim i As Long 'Zähler für Schleife Dim ret As VbMsgBoxResult 'Existiert die Datei bereits? If "" = Dir(strFile) Then 'alles gut, unten gehts weiter Else ret = MsgBox(strFile & vbCrLf & "Datei existiert bereits." _ & String(2, vbCrLf) & "Überschreiben?", vbYesNo + vbQuestion, "Sub Write2File") If vbYes = ret Then Kill strFile 'Datei löschen Else MsgBox "Keine Datei erstellt.", vbOKOnly, "Abgebrochen" Exit Sub End If End If ' Datei erstellen und befüllen Dim F F = FreeFile 'liefert nächsten freien Index On Error GoTo ErrHandler Open strFile For Output As #F On Error GoTo 0 'Schleife durch String-Arrays - Header For i = LBound(strHeader) To UBound(strHeader) Print #F, strHeader(i) 'Alternativ Write Next 'i 'Inhalt For i = LBound(strData) To UBound(strData) Print #F, strData(i) Next 'i Close #F 'Datei schließen On Error GoTo 0 Exit Sub 'Fehlerbehandlung ErrHandler: MsgBox Err.Description, vbCritical, Err.Number End Sub Private Sub writeLine2Array(strElement As String) ' fügt dem bestehenden Array ein weiteres Element hinzu ' wird am Ende angehängt ' gaStr_CSV globale Variable (Modulebene) Dim idx As Long On Error Resume Next idx = UBound(gaStr_CSV) 'derzeit höchster Index ' liefert einen Fehler, falls Array noch nicht initialisiert ist If Not 0 = Err.Number Then 'Array ist noch leer Err.Clear ReDim gaStr_CSV(0) idx = 0 ElseIf 0 = idx And "" = gaStr_CSV(0) Then 'Array ist initialisiert, aber noch leer idx = 0 '-> erster Index wird benutzt/gefüllt Else 'Standardfall, Array hat schon Inhalte idx = idx + 1 'künftig höchster Index ReDim Preserve gaStr_CSV(idx) 'Array um 1 vergrößern End If On Error GoTo 0 gaStr_CSV(idx) = strElement 'höchsten Index befüllen End Sub ' Sortieralgorithmus QuickSort_s speziell für Strings ' https://www.vbarchiv.net/tipps/details.php?id=959 ' 'hierzu gehört auch die Deklaration CopyMemoryPtr im Modul ganz oben ' Public Sub QuickSort_s(ByRef vSort() As String, _ Optional ByVal lngStart As Variant, _ Optional ByVal lngEnd As Variant) ' Wird die Bereichsgrenze nicht angegeben, ' so wird das gesamte Array sortiert If IsMissing(lngStart) Then lngStart = LBound(vSort) If IsMissing(lngEnd) Then lngEnd = UBound(vSort) Dim i As Long Dim j As Long Dim X As String Dim n As Long Dim nPtr As LongPtr 'KraBBy: war Long On Error Resume Next i = lngStart: j = lngEnd n = ((lngStart + lngEnd) \ 2) X = vSort(n) ' Array aufteilen Do Do While (StrComp(vSort(i), X, vbTextCompare) = -1): i = i + 1: Loop Do While (StrComp(vSort(j), X, vbTextCompare) = 1): j = j - 1: Loop If (i <= j) Then ' Wertepaare miteinander tauschen nPtr = StrPtr(vSort(i)) CopyMemoryPtr VarPtr(vSort(i)), VarPtr(vSort(j)), Len(nPtr) CopyMemoryPtr VarPtr(vSort(j)), VarPtr(nPtr), Len(nPtr) i = i + 1: j = j - 1 End If Loop Until (i > j) ' Rekursion (Funktion ruft sich selbst auf) If (lngStart < j) Then QuickSort_s vSort, lngStart, j If (i < lngEnd) Then QuickSort_s vSort, i, lngEnd On Error GoTo 0 End Sub ' QuickSort-Algorithmus, allgemein: DatenTyp Variant ' https://www.vbarchiv.net/tipps/details.php?id=372 ' ' vSort() : zu sortierendes Array ' lngStart, lngEnd: zu sortierender Bereich ' ========================================== Public Sub QuickSort(vSort As Variant, _ Optional ByVal lngStart As Variant, _ Optional ByVal lngEnd As Variant)
' Wird die Bereichsgrenze nicht angegeben, ' so wird das gesamte Array sortiert If IsMissing(lngStart) Then lngStart = LBound(vSort) If IsMissing(lngEnd) Then lngEnd = UBound(vSort) Dim i As Long Dim j As Long Dim h As Variant Dim X As Variant i = lngStart: j = lngEnd X = vSort((lngStart + lngEnd) / 2) ' Array aufteilen Do While (vSort(i) < X): i = i + 1: Wend While (vSort(j) > X): j = j - 1: Wend If (i <= j) Then ' Wertepaare miteinander tauschen h = vSort(i) vSort(i) = vSort(j) vSort(j) = h i = i + 1: j = j - 1 End If Loop Until (i > j) ' Rekursion (Funktion ruft sich selbst auf) If (lngStart < j) Then QuickSort vSort, lngStart, j If (i < lngEnd) Then QuickSort vSort, i, lngEnd End Sub
Wenn ich Excel schließe, dann kann ich im Task Manager sehen, daß es beim Unterpunkt Hintergrundprozesse noch zu finden ist und folglich noch läuft. Dort meldet er mir nach Ausführung des Codes "Run-time error 70 - Permission denied"
Kann ich Excel zu Beginn nicht irgendwie vollständig beenden und auch eventuell noch laufende Hintergrundprozesse? Wenn ich diese Instanz nun selber beende, läuft es soweit, aber er meldet mir dann, daß das Dokument durch "einen anderen Benutzer" gesperrt ist. Für mich völlig unlogisch, weil das Dokument gerade erst erstellt wurde und schon von einem anderen Benutzer gesperrt sein soll?
Deshalb wollte ich es so schreiben
Code: '-> Datei öffnen Dim ws As Object Set ws = CreateObject("WScript.Shell") 'Umweg, weil ich es mit dem integrierten Shell-Befehl nicht geschafft hab ws.Run Chr(34) & str_CSVdatei & Chr(34), ReadOnly:=True 'öffnet die geschriebene Datei mit der in Windows zugeordneten Anwendung
Aber das funktioniert so irgendwie nicht. Bin mir aber nicht sicher, ob das so der richtige Weg ist? Gleichzeitig stelle ich nämlich fest, daß durch das Öffnen im schreibgeschützten Modus der nachfolgende Code keine Wirkung mehr zeigt. Er sortiert also die Zeilen gar nicht mehr. ------------------
Du bist die Aufgabe - Franz Kafka Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 27. Okt. 2021 12:09 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
Hallo Du startest zwei Excel Instanzen. Die zweite kann die CSV-Datei nur schreibgeschützt öffnen (logisch oder?). Dann arbeitest du mit der zweiten, schreibgeschützten und nicht sichtbaren Instanz weiter. Du beendest dann die sichtbare Instanz, aber die andere läuft im Hintergrund weiter. Kommentiere den Code für Instanz 1 aus und mach Instanz 2 mit "oExcelApp.Visible = True" sichtbar. Instanz 1: Code:
Dim ws As Object Set ws = CreateObject("WScript.Shell") 'Umweg, weil ich es mit dem integrierten Shell-Befehl nicht geschafft hab ws.Run Chr(34) & str_CSVdatei & Chr(34) 'öffnet die geschriebene Datei mit der in Windows zugeordneten Anwendung
Instanz 2: Code:
Set oExcelApp = GetObject("", "Excel.Application") If oExcelApp Is Nothing Then MsgBox ("Can't get Excel") Exit Sub End If Set oWB = oExcelApp.Workbooks.Open(str_CSVdatei) oExcelApp.Visible = True
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Honigbär Mitglied Angestellter
Beiträge: 158 Registriert: 22.10.2006 CATIA V5 R24 Solid Edge Version 17 Pro-E Wildfire 4.0 Autodesk Inventor Professional 2014 MathCAD 13 Intel Centrino 2 (Pentium III Xeon) 2,53 GHz 6GB RAM Win 7 Ultimate (64 Bit) ATI Mobility Radeon HD 4650 SSD von Samsung (Festplatte)
|
erstellt am: 29. Okt. 2021 08:42 <-- editieren / zitieren --> Unities abgeben:
Danke für den Hinweis. War mir offensichtlich nicht aufgefallen. Nun habe ich diese Zeile
Code: ws.Run Chr(34) & str_CSVdatei & Chr(34) 'öffnet die geschriebene Datei mit der in Windows zugeordneten Anwendung
auskommentiert und an entsprechender Stelle mit Code: oExcelApp.Visible = True
die zweite Instanz sichtbar gemacht. Leider wurde meine Hoffnung darauf, daß es nun endlich funktionieren würde, wieder zunichte gemacht.
Und dieser Fehler taucht bei dir nicht auf? Habe ich eventuell irgendwo etwas übersehen? Ich bitte nochmal um Hilfe. :-( ------------------
Du bist die Aufgabe - Franz Kafka Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
BernoAn Mitglied
Beiträge: 172 Registriert: 16.01.2014
|
erstellt am: 29. Okt. 2021 10:23 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
|
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2580 Registriert: 15.11.2006 Windows 10 x64, AIP 2020-2025
|
erstellt am: 29. Okt. 2021 23:49 <-- editieren / zitieren --> Unities abgeben: Nur für Honigbär
Hallo Ich hab den Code bisher noch gar nicht ausprobiert. Mir fehlt da auch manchmal die Zeit. Dann schaue ich mir nur den aktuellen Fehler an. Ich finde den ganze Part alles erst in eine CSV-Datei zu schreiben und dann in Excel öffnen irgendwie zu umständlich. Das liefert jede Menge Fehlerpunkte. Um das zu reduzieren, schlage ich vor du schreibst den Inhalt deiner Stücklistenzeilen direkt in die Exceltabelle. Ich hab das mal eingebaut und alles bei der Variante obsolete heraus gelöscht. Code:
Option ExplicitPublic Sub btn_test_Click() Dim oExcelApp As Excel.Application Dim oWB As Workbook Dim oWS As WorkSheet ' Set a reference to the assembly document. ' This assumes an assembly document is active. Dim oDoc As AssemblyDocument Set oDoc = ThisApplication.ActiveDocument Dim FirstLevelOnly As Boolean If MsgBox("First level only?", vbYesNo) = vbYes Then FirstLevelOnly = True Else FirstLevelOnly = False End If ' Set a reference to the BOM Dim oBOM As BOM Set oBOM = oDoc.ComponentDefinition.BOM ' Set whether first level only or all levels. If FirstLevelOnly Then oBOM.StructuredViewFirstLevelOnly = True Else oBOM.StructuredViewFirstLevelOnly = False End If ' Make sure that the structured view is enabled. oBOM.StructuredViewEnabled = True 'Set a reference to the "Structured" BOMView Dim oBOMView As BOMView For Each oBOMView In oBOM.BOMViews If oBOMView.ViewType = kStructuredBOMViewType Then Exit For End If Next If oBOMView Is Nothing Then Call MsgBox("Strukturierte Stückliste nicht aufrufbar. Abbruch", vbCritical, "Export BOM to CSV") Exit Sub End If '-> initialize Array für Header (Kopfzeile) Dim sHeaderCSV(0) As String sHeaderCSV(0) = "Item; Quantity; Einheit; Description; Part Number; Stock Number" '################################################################################################################################### ' Die globale Variable sollte wirklich raus. Wird die globale Variable an anderer Stelle verwendet oder nur in diesem Modul? ' Wenn nur in diesem Modul, dann lieber lokale Variable ByRef weitergeben '-> init Array mit Listeneinträgen Dim gaStr_CSV() As String '################################################################################################################################### 'Prüfen ob Excel vorhanden ist Set oExcelApp = GetObject("", "Excel.Application") If oExcelApp Is Nothing Then MsgBox ("Can't get Excel") Exit Sub End If Set oWB = oExcelApp.Workbooks.Add If Not oWB Is Nothing Then Set oWS = oWB.ActiveSheet oWS.Name = "Test" 'Spaltenkopf schreiben oWB.ActiveSheet.Range("A1:F1") = Split(sHeaderCSV(0), ";") 'Datenreihen schreiben Call QueryBOMRowProperties(oWS, oBOMView.BOMRows) End If If Not oWS Is Nothing Then 'Stueckliste in Zeilen nach Nummerierung sortieren oWS.Sort.SortFields.Clear oWS.Sort.SortFields.Add2 Key:=oWS.Range("A3:A73"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With oWS.Sort .SetRange oWS.Range("A3:E73") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With oWS.Range("C3").Value = "Stück" End If 'Aufräumen Set oWS = Nothing 'Eventuell noch offene Instanzen schließen oWB.SaveAs ("C:\Temp\Text.xlsx") oWB.Close If oExcelApp.Workbooks.Count = 0 Then oExcelApp.Quit End If End Sub Private Sub QueryBOMRowProperties(ByRef oWS As WorkSheet, oBOMRows As BOMRowsEnumerator, Optional ByRef iRownumber As Integer = 0) ' Iterate through the contents of the BOM Rows. Dim i As Long For i = 1 To oBOMRows.Count ' Get the current row. Dim oRow As BOMRow Set oRow = oBOMRows.Item(i) 'Set a reference to the primary ComponentDefinition of the row Dim oCompDef As ComponentDefinition Set oCompDef = oRow.ComponentDefinitions.Item(1) iRownumber = iRownumber + 1 Dim oPartNumProperty As Property Dim oDescripProperty As Property Dim oStockNoProp As Property Dim sDataString As String If TypeOf oCompDef Is VirtualComponentDefinition Then 'Get the file property that contains the "Part Number" 'The file property is obtained from the virtual component definition Set oPartNumProperty = oCompDef.PropertySets _ .Item("Design Tracking Properties").Item("Part Number") 'Get the file property that contains the "Description" Set oDescripProperty = oCompDef.PropertySets _ .Item("Design Tracking Properties").Item("Description") Set oStockNoProp = oCompDef.PropertySets _ .Item("Design Tracking Properties").Item("Stock Number") sDataString = oRow.ItemNumber & ";" & oRow.ItemQuantity & ";;" & oDescripProperty.Value & ";" & oPartNumProperty.Value & ";" & oStockNoProp.Value oWS.Range("A" & iRownumber + 2 & ":F" & iRownumber + 2) = Split(sDataString, ";") Else 'Get the file property that contains the "Part Number" 'The file property is obtained from the parent 'document of the associated ComponentDefinition. Set oPartNumProperty = oCompDef.Document.PropertySets _ .Item("Design Tracking Properties").Item("Part Number") 'Get the file property that contains the "Description" Set oDescripProperty = oCompDef.Document.PropertySets _ .Item("Design Tracking Properties").Item("Description") Set oStockNoProp = oCompDef.Document.PropertySets _ .Item("Design Tracking Properties").Item("Stock Number") sDataString = oRow.ItemNumber & ";" & oRow.ItemQuantity & ";;" & oDescripProperty.Value & ";" & oPartNumProperty.Value & ";" & oStockNoProp.Value oWS.Range("A" & iRownumber + 2 & ":F" & iRownumber + 2) = Split(sDataString, ";") 'Recursively iterate child rows if present. If Not oRow.ChildRows Is Nothing Then Call QueryBOMRowProperties(oWS, oRow.ChildRows, iRownumber) End If End If Next End Sub
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|