Option
Explicit
Private
Const
REPO_XML_NAMESPACE =
"my-project.company.com"
Private
Const
REPO_VERSION =
"1.0"
Private
Const
NODE_WKS =
"worksheet"
Private
Const
ATTR_CODENAME =
"codename"
Private
Const
ATTR_NAME =
"name"
Private
Const
ATTR_OLDNAME =
"oldname"
Private
m_objLocalRepo
As
Office.CustomXMLPart
Public
Function
GetName(Worksheet
As
Excel.Worksheet)
As
String
GetName = GetNameInternal(Worksheet)
End
Function
Public
Function
AddOrUpdate(Worksheet
As
Excel.Worksheet, NewName
As
String
)
As
String
AddOrUpdate = AddOrUpdateInternal(Worksheet, NewName)
End
Function
Public
Sub
Clear()
Call
ClearInternal
End
Sub
Private
Sub
EnsureInitialized()
Call
InitializeRespository
End
Sub
Private
Function
GetNameInternal(Worksheet
As
Excel.Worksheet)
As
String
Call
EnsureInitialized
Dim
xmlNode
As
Office.CustomXMLNode
Set
xmlNode = m_objLocalRepo.DocumentElement.SelectSingleNode(
"./"
& NODE_WKS &
"/@"
& ATTR_NAME)
If
Not
xmlNode
Is
Nothing
Then
GetNameInternal = xmlNode.Text
Else
GetNameInternal = vbNullString
End
If
End
Function
Private
Function
AddOrUpdateInternal(Worksheet
As
Excel.Worksheet, NewName
As
String
)
As
String
Call
EnsureInitialized
With
m_objLocalRepo.DocumentElement
Dim
xmlNode
As
Office.CustomXMLNode
Set
xmlNode = .SelectSingleNode(
"./"
& NODE_WKS &
"[@"
& ATTR_CODENAME &
"='"
& Worksheet.CodeName &
"']"
)
If
Not
xmlNode
Is
Nothing
Then
Dim
strName
As
String
strName = xmlNode.SelectSingleNode(
"./@"
& ATTR_NAME).Text
xmlNode.SelectSingleNode(
"./@"
& ATTR_OLDNAME).Text = strName
xmlNode.SelectSingleNode(
"./@"
& ATTR_NAME).Text = NewName
AddOrUpdateInternal = strName
Else
Call
.AppendChildNode(Name:=NODE_WKS)
With
.SelectSingleNode(
"./"
& NODE_WKS &
"[last()]"
)
Call
.AppendChildNode(NodeValue:=Worksheet.CodeName, NodeType:=msoCustomXMLNodeAttribute, Name:=ATTR_CODENAME)
Call
.AppendChildNode(NodeValue:=NewName, NodeType:=msoCustomXMLNodeAttribute, Name:=ATTR_NAME)
Call
.AppendChildNode(NodeValue:=Worksheet.Name, NodeType:=msoCustomXMLNodeAttribute, Name:=ATTR_OLDNAME)
End
With
AddOrUpdateInternal = Worksheet.Name
End
If
End
With
End
Function
Private
Sub
ClearInternal()
Call
EnsureInitialized
Do
While
m_objLocalRepo.DocumentElement.ChildNodes.Count > 0
Call
m_objLocalRepo.DocumentElement.ChildNodes(1).Delete
Loop
End
Sub
Private
Sub
InitializeRespository()
If
m_objLocalRepo
Is
Nothing
Then
With
ThisWorkbook.CustomXMLParts
With
.SelectByNamespace(REPO_XML_NAMESPACE)
If
.Count > 0
Then
Set
m_objLocalRepo = .Item(1)
Exit
Sub
End
If
End
With
Set
m_objLocalRepo = .Add(
"<repo xmlns="
""
& REPO_XML_NAMESPACE &
""
" version="
""
& REPO_VERSION &
""
"/>"
)
End
With
End
If
End
Sub