---

Wie schon einer meiner Vorgänger geschrieben hat: "Hallo liebe Fachwelt".
Ich habe mit großer Begeisterung und auch mit Erfolg das Makro von noctis79 (http://ww3.cad.de/foren/ubb/Forum258/HTML/001256.shtml) bei mir in mein "System" einbinden können. Erstmal danke für den Beitrag Didikalle und danke noctis79 für die super Anleitung. Hat bei mir alles super funktioniert. ABER:...

Ist es möglich genau dieses Makro auch so umzuwandeln das die Stückliste strukturiert, mit allen Ebenenen und sortiert die Stückliste in meine Excel-Datei exportiert?

Die Reihenfolge der Sortierung sollte nach folgenden Kriterien erfolgen:

1. Bauteilnummer
2. Bezeichnung bzw. Beschreibung
3. Nach der Anzahl

Habe leider schon vergebends danach gesucht und bin nicht so wirklich fündig geworden...und wenn doch habe ich es nicht verstanden.
Vielleicht kann ja jemand das Makro so umschreiben das es auch funktioniert 

Anbei ist mein Makro wie ich es bei mir eingebunden und angepasst habe. Im Voraus vielen Dank für Eure Mühen. Ihr würdet mir sehr weiterhelfen...
Zur Info: Wir benutzen Inventor 2014 - Professional unter Windows 7 (Was wahrscheinlich keine Rolle spiel  )

Sub Stückliste()
Dim oapp As Inventor.Application

Set oapp = ThisApplication

Dim odoc As Inventor.DrawingDocument

If oapp.ActiveDocument.DocumentType <> kDrawingDocumentObject Then
    MsgBox "Makro ist nur in Zeichnungen zulässig"
    Exit Sub
End If

Set odoc = oapp.ActiveDocument

Dim oOptions As NameValueMap

Dim oName, oStart, oTemplate, oFullFileName, oFileName, oXLSFileName  As String
Dim oLength As String
Dim oFit As Boolean
Dim oProp As PropertySet
Dim i As Property
Dim oDescription As String
Dim oPartNumber As String

Set oProp = odoc.PropertySets.Item("Design Tracking Properties")

For Each i In oProp
    If i.DisplayName = "Bezeichnung" Then
        oDescription = i.Expression
    ElseIf i.DisplayName = "Bauteilnummer" Then
        oPartNumber = i.Expression
    ElseIf i.DisplayName = "Projekt" Then
        oProject = i.Expression
    ElseIf i.DisplayName = "Erstellungsdatum" Then
        oDateFileCreated = i.Expression
    ElseIf i.DisplayName = "Konstrukteur" Then
        oCreatedBy = i.Expression
    End If
 
Next

oFileName = oPartNumber & " - " & oDescription

Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

oXLSFileName = "C:\Vault\Konstruktion\Stücklisten\" & oFileName & ".xls"
'oName = Name des Excel- Sheets
oName = "Stückliste"
'oStart = Start- Zelle
oStart = "A7"
'oTemplate = Pfad zum xls- Template
oTemplate = "F:\Konstruktion\Inventor\Inventor 2014\02 - Vorlagen\Vorlage Stückliste - Firmenname.xls"
'oFit bewirkt, dass die Zellen eingepasst werden
'true - Zellen werden angepasst
'false - Zellen werden nicht angepasst
oFit = False

Call oOptions.Add("TableName", oName)
Call oOptions.Add("StartingCell", oStart)
Call oOptions.Add("Template", oTemplate)
Call oOptions.Add("AutoFitColumnWidth", oFit)

If odoc.ActiveSheet.PartsLists.Count = 0 Then
    MsgBox "Keine Stückliste vorhanden!", vbCritical + vbOKOnly, "Stückliste fehlt"
    Exit Sub
ElseIf odoc.ActiveSheet.PartsLists.Count > 1 Then
    MsgBox "Es sind mehrere Stücklisten vorhanden!" & vbCrLf & "Es wird die erste Stückliste verwendet!" _
    , vbOKOnly + vbInformation, "Mehrere Stücklisten"
End If

'Nachträglich eingefügt Anfang
Dim objFSO As FileSystemObject
Set objFSO = New FileSystemObject
If Not objFSO.FileExists(oTemplate) Then
    MsgBox "Vorlagendatei: Vorlage Stückliste - Firmenname.xls wurde nicht gefunden! Bitte überprüfen Sie Ihre Einstellungen.", vbCritical + vbOKOnly, "Datei nicht vorhanden"
    Exit Sub
End If
'Nachträglich eingefügt Ende

Call odoc.ActiveSheet.PartsLists.Item(1).Export(oXLSFileName, kMicrosoftExcel, oOptions)

'************************* Ab hier der EXCEL- PART ****************
'Im Inventor VBA- Projekt auf Extras - Verweise und
'die Microsoft Excel Library hinzufügen
'******************************************************************

Dim oExl As New Excel.Application

On Error Resume Next
Set oExl = GetObject(, "Excel.Application")
  If Err.Number Then
    Err.Clear
    On Error Resume Next
    Set oExl = CreateObject("Excel.Application")
    If Err.Number Then
      Err.Clear
      MsgBox "Kann Excel nicht öffnen."
    End If
  End If

oExl.Workbooks.Open (oXLSFileName)
With oExl.ActiveWorkbook
  .Sheets(oName).Cells(4, 5) = oPartNumber
  .Sheets(oName).Cells(4, 1) = oDescription
  .Sheets(oName).Cells(2, 7) = oProject
  .Sheets(oName).Cells(4, 6) = oDateFileCreated
  .Sheets(oName).Cells(4, 7) = oCreatedBy
  .Close 1

End With

End Sub

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

---

Poste mal wie die Stückliste in der idw aussieht und wie du sie dann im endefekt haben möchtest.
Ich habe mir jetzt deinen Code nicht angesehen jedoch habe ich mir auch ein Makro geschrieben was meine Stückliste für ein Ersatzteilprogramm vorbereitet.

1:1 Ausgabe ist nicht schwer, umstrukturierung muss nach einem Schema erfolgen und das musst du kennen bzw uns darlegen.

------------------
Grüße aus Wien
Philipp

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

---

StucklisteIDW.JPG ExportnachExcel.JPG

Ok...
erstmal sorry für die späte Antwort. Habe es nicht eher geschafft. Habe jetzt 2 Bilder eingefügt die die Stückliste der .idw zeigen und ein Bild das den fertigen Excel-Export zeigt. In diesem Fall manuell verändert ;-)

Die Stückliste der .idw soll allerdings nicht verändert werden. Nur der Export der Stückliste soll strukturiert und mit allen Ebenen sein. Natürlich soll auch im Hintergrund die Sortierung laufen ;-)

Wäre es eigentlich auch noch möglich benutzerdefinierte Parameter wie z.B. "Hersteller"
mit zu exportieren?

Fragen über Fragen...

Danke nochmal für Deine Mühe

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

---

IV2014_VBA_iProperties.pdf

Die Positionsnummern sind bei dir anscheinend nicht wichtig da sie ja nicht übereinstimmen oder? Warum exportierst du sie denn wenn ich fragen darf?
Was die Sortierung angeht kann ich dir leider nicht besonders helfen, da ich mich mit dem noch nicht auseinander gesetzt habe.
2 Fragen stellen sich mir da wenn ich darüber aber nachdenke ist es schneller wenn man die Daten im Makro sortiert und dann schreibt oder zuerst ins Excel schreibt und die Sortierung dann dort vom Makro durchführen lässt.

Auf deine Frage ob man auch Benutzerdefs auslesen kann: Alles was du bei den iProperties findest kannst du auslesen
Dazu mein lieblings PDF dort findest du alle Infos wie du an welche iProperties kommst =)

------------------
Grüße aus Wien
Philipp

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

---

Sie sind doch richtig und stimmen auch! Sie sind halt strukturiert. Natürlich sollen sie auch exportiert werden. Würde sicherlich auch gehen nach dem Export die Sortierung in der Excel-Datei neu zu starten. Aber warum nicht gleich in dem selben Marko. Mit dem Makro funktioniert ja der Export - Zumindest in der Struktur:

Public Sub BOMExport()
    ' Set a reference to the assembly document.
    ' This assumes an assembly document is active.
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument

    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
   
    ' Set the structured view to 'all levels'
    oBOM.StructuredViewFirstLevelOnly = False

    ' Make sure that the structured view is enabled.
    oBOM.StructuredViewEnabled = True

    ' Set a reference to the "Structured" BOMView
    Dim oStructuredBOMView As BOMView
    Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")
   
    ' Export the BOM view to an Excel file
    oStructuredBOMView.Export "C:\temp\BOM-StructuredAllLevels.xls", kMicrosoftExcelFormat

Jetzt will ich allerdings eine Vorlage nutzen wo Inventor die Daten hereinschreibt und sie sollen dann noch nach Möglichkeit sortiert werden ohne das ich das manuell erledigen muss.

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

---

Hat denn niemand eine Idee? Bin mittlerweile am verzweifeln. Selbst mit den Inventor-Tutorials komme ich zu keinem Ergebnis. Google hilft mir auch nicht weiter...

   

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