Option Explicit
Sub SaveValueInCustomDocProperty()
' ============================================
' Save a value in CustomDocumentProperties
' ============================================
' Constant string for the property we are adding
Const szVersion As String = "WorkbookVersion"
' ========================================================================
' If the name doesn't exist, we create it and set the initial value to 1
On Error Resume Next
Dim cstmDocProp As DocumentProperty
Set cstmDocProp = ThisWorkbook.CustomDocumentProperties(szVersion)
If Err.Number > 0 Then
ThisWorkbook.CustomDocumentProperties.Add _
Name:=szVersion, _
LinkToContent:=False, _
Type:=msoPropertyTypeNumber, _
Value:=1
' ========================================================================
Else
' ========================================================================
' if our name exists, we need to increment the value in it by 1
' to do this, we parse the name's RefersTo value:
Dim szDocVal As String
szDocVal = ThisWorkbook.CustomDocumentProperties(szVersion).Value
' Reset the name to refer to our new value
ThisWorkbook.CustomDocumentProperties(szVersion).Value = CLng(szDocVal) + 1
' ========================================================================
End If
' Explicitly clear memory
Set cstmDocProp = Nothing
End Sub
|