Code:
Option Explicit
--------------------------------------------------
'Abbrechen Button klicken
Private Sub CommandButton_Abbrechen_Click()
Unload UserForm_Index_1
End Sub
-------------------------------------------------
'Vorschläge im Textfeld
Public Sub UserForm_Initialize() ' Get the active document.
Dim doc As Document
Set doc = ThisApplication.ActiveDocument
' Get the custom property set.
Dim customPropSet As PropertySet
Set customPropSet = doc.PropertySets.Item("Inventor User Defined Properties")
Dim IndexCurrent As Property
Dim AenderungCurrent As Property
Dim DatumCurrent As Property
Dim NameCurrent As Property
'Versuche die iProperty Einträge abzurufen
On Error Resume Next
Set IndexCurrent = customPropSet.Item("1.Index")
Set AenderungCurrent = customPropSet.Item("1.Änderung")
Set DatumCurrent = customPropSet.Item("1.Datum")
Set NameCurrent = customPropSet.Item("1.Name")
'Wenn iProperty Einträge abzurufen fehlerhaft dann
If Err.Number <> 0 Then
IndexCurrent.Value = ""
AenderungCurrent.Value = ""
DatumCurrent.Value = ""
NameCurrent.Value = ""
End If
' Wenn iPropertie noch nicht vorhanden dann zeige... sonst zeige bestehenden Wert
If IndexCurrent.Value = "" Then
UserForm_Index_1.TextBox_Index.Value = "A"
Else: UserForm_Index_1.TextBox_Index.Value = IndexCurrent.Value
End If
If AenderungCurrent.Value = "" Then
UserForm_Index_1.TextBox_Aenderung.Value = ""
Else: UserForm_Index_1.TextBox_Aenderung.Value = AenderungCurrent.Value
End If
If DatumCurrent.Value = "" Then
UserForm_Index_1.TextBox_Datum.Value = Format(Date, "dd.mm.yyyy")
Else: UserForm_Index_1.TextBox_Datum.Value = DatumCurrent.Value
End If
If NameCurrent.Value = "" Then
UserForm_Index_1.TextBox_Name.Value = ThisApplication.GeneralOptions.UserName
Else: UserForm_Index_1.TextBox_Name.Value = NameCurrent.Value
End If
End Sub
----------------------------------------------------
Private Sub CommandButton_Uebernehmen_Click()
' Get the active document.
Dim doc As Document
Set doc = ThisApplication.ActiveDocument
' Update or create the custom iProperty.
Call UpdateCustomiProperty(doc, "1.Index", UserForm_Index_1.TextBox_Index.Value)
Call UpdateCustomiProperty(doc, "1.Änderung", UserForm_Index_1.TextBox_Aenderung.Value)
Call UpdateCustomiProperty(doc, "1.Datum", UserForm_Index_1.TextBox_Datum.Value)
Call UpdateCustomiProperty(doc, "1.Name", UserForm_Index_1.TextBox_Name.Value)
' Schließe Fenster
Unload UserForm_Index_1
End Sub
----------------------------------------------------------
Public Sub UpdateCustomiProperty(ByRef doc As Document, _
ByRef PropertyName As String, _
ByRef PropertyValue As Variant)
' Get the custom property set.
Dim customPropSet As PropertySet
Set customPropSet = doc.PropertySets.Item("Inventor User Defined Properties")
' Get the existing property, if it exists.
Dim prop As Property
On Error Resume Next
Set prop = customPropSet.Item(PropertyName)
' Check to see if the above call failed. If it failed
' then the property doesn't exist.
If Err.Number <> 0 Then
' Failed to get the existing property so create a new one.
Set prop = customPropSet.Add(PropertyValue, PropertyName)
Else
' Change the value of the existing property.
prop.Value = PropertyValue
End If
End Sub