Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Stücklisten export mit Benutzerdefinierten Propertys

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:  Stücklisten export mit Benutzerdefinierten Propertys (1572 mal gelesen)
mbHD83
Mitglied
Konstrukteur

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

Beiträge: 2
Registriert: 19.02.2015

erstellt am: 19. Feb. 2015 14:35    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


CustomPropertys.JPG

 
Hallo Zusammen,

ich habe in den letzten Tage einige Beträge durchgearbeit auf der Suche nach einem Macro für den Automatisierten Export einer Stückliste in eine Excel-Vorlage.
Bin soweit auch fündig geworden und konnte den Großteil meiner Bedürfnisse anpassen und es für mich Übersichtlich machen. Das hat soweit auch gut geklappt bis auf  das Eintragen von "Benutzerdefinierten iPropertys" und einem flexibelen AblagePfad der beim Exportieren (über dropdown Menü) ausgewählt werden kann. Ich habe einiges ausprobiert und bin leider zu keinem Ergebniss gekommen.

hier mein aktueller Code mit meinem letzten kläglichen Versuch.

______________________________________________________________________________________________________________________________________________________________________

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 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
    End If
    Next
     
'_____________________________________________________________________________________________________

'Dim k As CustomProperty
'Dim oKonstName As String
'Dim oKonstDatum As String
'Dim oGezDatum As String
'Dim oGezName As String
'Dim oTitel2 As String

'Set oProp = odoc.CustomPropertyFormat.Item("Design Tracking Properties")
   
'For Each k In oProp
'    If k.DisplayName = "KonstName" Then
'        oKonstName = k.Expression
'    ElseIf k.DisplayName = "KonstDatum" Then
'        oKonstDatum = k.Expression
'    ElseIf k.DisplayName = "GezDatum" Then
'        oGezDatum = k.Expression
'    ElseIf k.DisplayName = "GezName" Then
'        oGezName = k.Expression
'    ElseIf k.DisplayName = "Titel2" Then
'        oTitel2 = k.Expression
'    End If
'    Next
'_____________________________________________________________________________________________________

   

oFileName = "Stüli" & " - " & oPartNumber

Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

oXLSFileName = "E:\test\" & oFileName & ".xls"
'oName = Name des Excel- Sheets bzw. Baugruppe
oName = oDescription
'oStart = Start- Zelle
oStart = "A9"
'oTemplate = Pfad zum xls- Template
oTemplate = "J:\Stüli-Vorlage.xls"

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

'_________________________________________________________________________________________________________


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

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, 1) = oPartNumber
  '.Sheets(oName).Cells(4, 4) = oKonstDatum
  '.Sheets(oName).Cells(4, 3) = oKonstName
  '.Sheets(oName).Cells(6, 4) = oGezDatum
  '.Sheets(oName).Cells(6, 3) = oGezName
  '.Sheets(oName).Cells(2, 3) = oTitel2
  .Close 1

End With

End Sub

__________________________________________________________________________________________________________________________________________________


Da ich leider so gut wie keine Ahnung von VBA Programmierung habe hoffe ich das mir hier jemand Helfen kann meine Probleme zu Lösen.

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

mbHD83
Mitglied
Konstrukteur

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

Beiträge: 2
Registriert: 19.02.2015

erstellt am: 20. Feb. 2015 13:18    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

Ich habe die halbe Nacht einige Foren durchstöbert und bin dabei auf eine Lösung für das Übertragen der Benutzerdefinierten iPropertys gestoße. Und konnte das auch erfolgreich Umsetzen.

Beim vormatieren der Excel-Vorlage ist mir noch aufgefallen das der 2. Excelsheet nicht ausgefüllt wird (für die englische Version).

Und leider habe ich noch nicht mahl einen Ansatz für die Lösung des Ablagepfades über ein dropdown Menü bzw einen Browser gefunden.
Muss ich den Browser als UserForm erstellen?

hier der funktionierende Code.

___________________________________________________________________


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 oProp As PropertySet
Dim oProp3 As PropertySet

Dim i As Property
Dim k As Property

Dim oDescription As String
Dim oPartNumber As String
Dim oKonstName As String
Dim oKonstDatum As String
Dim oGezDatum As String
Dim oGezName As String
Dim oTitel2 As String


Set oProp = odoc.PropertySets.Item("Design Tracking Properties")
Set oProp3 = odoc.PropertySets.Item("Inventor User Defined Properties")

For Each i In oProp
    If i.DisplayName = "Bezeichnung" Then
        oDescription = i.Expression
    ElseIf i.DisplayName = "Bauteilnummer" Then
        oPartNumber = i.Expression
    End If
    Next
   
   
For Each k In oProp3
    If k.DisplayName = "KonstName" Then
        oKonstName = k.Expression
    ElseIf k.DisplayName = "KonstDatum" Then
        oKonstDatum = k.Expression
    ElseIf k.DisplayName = "GezDatum" Then
        oGezDatum = k.Expression
    ElseIf k.DisplayName = "GezName" Then
        oGezName = k.Expression
    ElseIf k.DisplayName = "Titel2" Then
        oTitel2 = k.Expression
    End If
    Next
   
'_____________________________________________________________________________________________________

   

oFileName = "Stüli" & " - " & oPartNumber

Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

oXLSFileName = "D:\Stücklisten\" & oFileName & ".xls"
'oName = Name des Excel- Sheets bzw. Baugruppe
oName = oDescription
'oStart = Start- Zelle
oStart = "A9"
'oTemplate = Pfad zum xls- Template
oTemplate = "J:\Stüli Export\Stüli-Vorlage.xls"

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

'_________________________________________________________________________________________________________


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

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, 4) = oKonstDatum
  .Sheets(oName).Cells(4, 3) = oKonstName
  .Sheets(oName).Cells(6, 4) = oGezDatum
  .Sheets(oName).Cells(6, 3) = oGezName
  .Sheets(oName).Cells(2, 3) = oTitel2
  .Close 1

End With

End Sub

______________________________________________________________________

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: 23. Feb. 2015 22: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 mbHD83 10 Unities + Antwort hilfreich

Hallo

Benutze die FileDialog.ShowSave Methode für die Auswahl des Ablageortes. Soweit ich das beim Überfliegen sehen konnte, steht nirgends etwas von einem zweiten Tabellenblatt. Wenn die selben Infos wie auf dem ersten WorkSheet auf's zweite sollen, müßtest du wenigstens mal das zweite Worksheet aktivieren und deinen Code zum Schreiben der Zellinhalte erneut ablaufen lassen.
By the way, du öffnest dein Excelfile und im festen Vertrauen das nach dem Öffnen schon das richtige WorkSheet das aktive ist, schreibst du deine Werte.

------------------
MfG
Ralf

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