Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Fehler im VBA Code beim Erstellen der Excel-Stückliste

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Fehler im VBA Code beim Erstellen der Excel-Stückliste (1590 mal gelesen)
Honigbär
Mitglied
Angestellter


Sehen Sie sich das Profil von Honigbär an!   Senden Sie eine Private Message an Honigbär  Schreiben Sie einen Gästebucheintrag für Honigbär

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von BernoAn an!   Senden Sie eine Private Message an BernoAn  Schreiben Sie einen Gästebucheintrag für BernoAn

Beiträge: 164
Registriert: 16.01.2014

erstellt am: 07. Okt. 2021 13:40    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Honigbär an!   Senden Sie eine Private Message an Honigbär  Schreiben Sie einen Gästebucheintrag für Honigbär

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Inv_Fehler.JPG

 
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




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 13. Okt. 2021 23:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Honigbär an!   Senden Sie eine Private Message an Honigbär  Schreiben Sie einen Gästebucheintrag für Honigbär

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 15. Okt. 2021 10:59    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Honigbär an!   Senden Sie eine Private Message an Honigbär  Schreiben Sie einen Gästebucheintrag für Honigbär

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 15. Okt. 2021 11:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

Hallo

Sag doch gleich dass du die englische Version hast. Da heißt das "Tools" --> "References" 

------------------
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


Sehen Sie sich das Profil von Honigbär an!   Senden Sie eine Private Message an Honigbär  Schreiben Sie einen Gästebucheintrag für Honigbär

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 15. Okt. 2021 19:13    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

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.Close

If 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


Sehen Sie sich das Profil von Honigbär an!   Senden Sie eine Private Message an Honigbär  Schreiben Sie einen Gästebucheintrag für Honigbär

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 20. Okt. 2021 20:21    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Honigbär an!   Senden Sie eine Private Message an Honigbär  Schreiben Sie einen Gästebucheintrag für Honigbär

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 27. Okt. 2021 12:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von Honigbär an!   Senden Sie eine Private Message an Honigbär  Schreiben Sie einen Gästebucheintrag für Honigbär

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von BernoAn an!   Senden Sie eine Private Message an BernoAn  Schreiben Sie einen Gästebucheintrag für BernoAn

Beiträge: 164
Registriert: 16.01.2014

erstellt am: 29. Okt. 2021 10:23    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

Hi,

Heißt das Blatt bei dir "Test"?
wohl eher "Tabelle1" ?

Lg
Berno

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 29. Okt. 2021 23:49    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Honigbär 10 Unities + Antwort hilfreich

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 Explicit

Public 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 >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz