Public Sub Property_Manager()
  
  Dim oDoc As Document
  
  'Überprüfung ob eine Baugruppe oder ein Einzelteil aktiv ist
  Set oDoc = ThisApplication.ActiveDocument
  If ((oDoc.DocumentType = kPartDocumentObject) Or (oDoc.DocumentType = kAssemblyDocumentObject)) Then
    'Überprüfung OK
  Else
    MsgBox "Eine Einzelteil- oder Baugruppenzeichnung muss aktiv sein"
    Exit Sub
  End If
  
  
  
  IPropertiesAbfrage.Show vbModeless
  
  Set oDoc = Nothing
  
End Sub


Sub Property_setzen(oDoc As Document, sPropName As String, vPropValue As Variant)
' Belegt eine Property mit einem Wert.
' Ist die Property nicht vorhanden, so wird sie angelegt.

    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
 
  
    Dim bPropertyDa As Boolean
    Dim oProp As Property
    
    bPropertyDa = False
    
    
    ' Iterate through all the PropertySets one by one using for loop
    ' and changing its value if found
    Dim oPropSet As PropertySet
    For Each oPropSet In oPropSets
    
        For Each oProp In oPropSet
            'Debug.Print oProp.Name
            If oProp.Name = sPropName Then
                oProp.Value = vPropValue
                bPropertyDa = True
                Exit For
            End If
        Next
        
    Next
    
  
    'Property anlegen und Wert eintragen
    
    If Not bPropertyDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add vPropValue, sPropName
        'oDoc.PropertySets.Item("User Defined Properties").Add vPropValue, sPropName
    End If

  
End Sub
  
'--------------------------------------------------------------------------------------------------



Public Function Property_lesen(oDoc As Document, sPropName As String) As Variant
' Liest eine Property.
' Ist die Property nicht vorhanden, so wird "" zurückgegeben.

    Property_lesen = ""

    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets
 
    Dim oProp As Property
    
    ' Iterate through all the PropertySets one by one using for loop
    Dim oPropSet As PropertySet
    For Each oPropSet In oPropSets
    
        For Each oProp In oPropSet
            'Debug.Print oProp.Name
            If oProp.Name = sPropName Then
                Property_lesen = oProp.Value
                Exit For
            End If
        Next
        
    Next

End Function
'--------------------------------------------------------------------------------------------------