Attribute VB_Name = "Modul2"
Sub Artikelnummer()
'Schreibt die Artikelbezeichnung des Bauteils in die benutzerdefinierten Eigenschaften als Eigenschaft "Artikel"

'Nur im Bauteil:
If ThisApplication.ActiveDocumentType = kPartDocumentObject Then
  
  Dim oDoc As PartDocument
  Set oDoc = ThisApplication.ActiveDocument
  
  'Wie ist der Artikel?
  Dim sArtikel, sArtikelDa, Prompt As String
  Prompt = "Artikelbezeichnung eingeben" & Chr(10) & Chr(13) & "max. 19 Zeichen"
  
  'Benutzerdefinierten Eintrag erzeugen
  'Artikel schon vorhanden?
  Dim bArtikelDa As Boolean
  Dim oProp As Property
  bArtikelDa = False
  For Each oProp In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
    If oProp.Name = "Artikel" Then
      bArtikelDa = True
      Exit For
    End If
  Next
  
  'Artikel vom Benutzer anfordern, wenn vorhanden vorgeben
  Do
  If bArtikelDa Then
    sArtikelDa = oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Artikel").Value
    sArtikel = InputBox(Prompt, "STP-Artikel", sArtikelDa)
    If sArtikel = "" Then Exit Sub
  Else
    sArtikel = InputBox(Prompt, "STP-Artikel")
    If sArtikel = "" Then Exit Sub
  End If
  Prompt = "Artikelbezeichnung eingeben" & Chr(10) & Chr(13) & "ACHTUNG!! max. 19 Zeichen"
  'MsgBox Len(sArtikel)
  Loop While Len(sArtikel) > 19 'Wenn die Artikelbezeichnung länger als 19 Zeichen ist
  
  'Artikel eintragen oder ändern
  If bArtikelDa Then
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Artikel").Value = sArtikel
  Else
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add sArtikel, "Artikel"
  End If
Else  'Kein Bauteil im aktiven Fenster
  Dim Msg As String
  Dim E As Integer
  Msg = "Artikelbezeichnung geht nur bei Bauteilen! "
  E = MsgBox(Msg, vbCritical, "Fehler")
End If

End Sub

Sub Dummy()
  End
End Sub