Option Explicit
Private Const C_XML_NAMESPACE As String = "local::valueStorage"
Private Const C_VALUES_MAX As Long = 30
Private m_objValueStorage As Office.CustomXMLPart
Private Sub Class_Initialize()
Set m_objValueStorage = GetValueStorage()
End Sub
Private Function GetValueStorage() As Office.CustomXMLPart
Dim objParts As Office.CustomXMLParts
Set objParts = ThisWorkbook.CustomXMLParts.SelectByNamespace(C_XML_NAMESPACE)
If objParts.Count > 0 Then
Set GetValueStorage = objParts.Item(1)
Else
Set GetValueStorage = InitValueStorage()
End If
End Function
Private Function InitValueStorage() As Office.CustomXMLPart
Dim objValueStorage As Office.CustomXMLNode
Dim i As Long
Set objValueStorage = ThisWorkbook.CustomXMLParts.Add("<valueStorage xmlns='" & C_XML_NAMESPACE & "'/>").SelectSingleNode("*")
For i = 1 To C_VALUES_MAX
Call objValueStorage.AppendChildNode("value", , , "")
Call objValueStorage.SelectSingleNode("value[last()]").AppendChildNode("ID", , msoCustomXMLNodeAttribute, CStr(i))
Next
Set InitValueStorage = objValueStorage.Parent
End Function
Public Property Get ValueCount() As Long
ValueCount = m_objValueStorage.SelectNodes("//value").Count
End Property
Public Property Let Value(Index As Long, NewValue As Variant)
m_objValueStorage.SelectSingleNode("//value[@ID=" & Index & "]").Text = CStr(NewValue)
End Property
Public Property Get Value(Optional Index As Long) As Variant
If Index = 0 Then
Dim objValues As Office.CustomXMLNodes
Dim i As Long
Set objValues = m_objValueStorage.SelectNodes("//value")
If objValues.Count > 0 Then
ReDim vntValues(1 To objValues.Count)
For i = 1 To objValues.Count
vntValues(i) = objValues(i).Text
Next
Value = vntValues
Else
Value = Split(vbNullString)
End If
Else
Value = m_objValueStorage.SelectSingleNode("//value[@ID=" & Index & "]").Text
End If
End Property