Montag, 12. März 2012 02:23
I have a need to store extra information about each cell in an Excel workbook. My plan would be to present this information and allow it to be editable via a custom RibbonBar tab.
I would want to allow a user within Excel to add this extra information to cells and then have this information be persisted when the workbook is saved normally. I'd want this information stored within the workbook, such that emailing the workbook to someone else and them opening the workbook would allow them to see the extra data set on cells.
I cannot find an elegant solution to this. An easy cop-out would be having a 'Tag' like property available on the range objects, but this does not exist.
I could abuse the comment tag on individual cells and store the data as serialised XML , but this just seems wrong.
Is there a better way of achieving this goal?
Neil Kimber - Director of Technology, CPR
Montag, 12. März 2012 04:39Beantworter
We have wanted a tag property for cells for a while, but its not in this version of Excel. One way to almost get the same result is to store additional information in the same cell in a different (hidden) worksheet.
Say the hidden sheet is named Sheet2, then add a tag with this method
Sub AddTag(rng As Range, strTag As String) Worksheets("Sheet2").Range(rng.Address).Value = strTag End Sub
Read the tag with a function
Function TagInfo(rng As Range) As String TagInfo = Worksheets("Sheet2").Range(rng.Address).Value End Function
I will let you add code to test for a range with more than one cell...
Montag, 12. März 2012 10:41
Thanks for the suggestion of using a hidden worksheet. I had also considered this and, in lieu of a better solution, I think I'll try this out.
The other alternative I had was to store the information in a separate file, unfortunately this would require the separate file to be distributed with the workbook. Unless I could do something clever and store the Excel workbook as XML and embed my information into the XML.
The other alternative approach I've considered is using document custom properties.
All of these approaches have different challenges, a Tag on individual cells would be a far preferable solution.
Neil Kimber - Director of Technology, CPR
Montag, 12. März 2012 11:22ModeratorRe-consider using cell Comments. Comments were specifically designed to handle this type of functionality.
Montag, 12. März 2012 18:30
One way to do this is using CustomXMLParts (which I have only just discovered). You can create and access these whilst the workbook is open and they persist in the workbook (assuming its one of the 2007 or later file formats). You can even read/write them from within a UDF. And they are fairly easy to debug because you can see the end result by unzipping the Excel XLSX file.
You would need a 2-part XML structure where one part is the cell address and the second part is the data you want to store.
here is some test code
Option Explicit Public gPart As CustomXMLPart Sub create() Dim xPart As CustomXMLPart For Each xPart In ActiveWorkbook.CustomXMLParts If Not xPart.BuiltIn Then xPart.Delete Next xPart Set gPart = ActiveWorkbook.CustomXMLParts.Add("<fxlUDF> </fxlUDF>") End Sub Sub testxml() Dim xPart As CustomXMLPart Dim xNode As CustomXMLNode Dim xNodes As CustomXMLNodes Dim strxml As String Dim s1 As String Dim j As Long For Each xPart In ActiveWorkbook.CustomXMLParts If Not xPart.BuiltIn Then xPart.Delete Next xPart strxml = "<FxlRowMap>" & _ "<Pair> <k>123</k> <i>456</i> </Pair>" & _ "<Pair> <k>124</k> <i>999</i> </Pair>" & _ "</FxlRowMap>" Set xPart = ActiveWorkbook.CustomXMLParts.Add(strxml) Set xNode = xPart.SelectSingleNode("/FxlRowMap") xNode.AppendChildSubtree ("<Pair> <k>125</k> <i>1010</i> </Pair>") Set xNodes = xPart.SelectNodes("/FxlRowMap/Pair") For Each xNode In xNodes s1 = xNode.SelectSingleNode("k").Text Debug.Print s1 Debug.Print xNode.SelectSingleNode("i").Text Next xNode End Sub Function Funcxml(theRange As Range) Dim xNode As CustomXMLNode Set xNode = gPart.SelectSingleNode("/fxlUDF") xNode.AppendChildSubtree ("<Cell> <RC>" & Application.Caller.Address & "</RC> <V>" & theRange.Value & "</V> </Cell>") Funcxml = theRange End Function
Charles Excel MVP The Excel Calculation Site http://www.decisionmodels.com/
- Als Antwort markiert DBNull Sonntag, 29. April 2012 12:36
Mittwoch, 15. Mai 2013 08:07
when I use the CustomXMLParts solution - what happens if the user inserts/deletes rows/columns?
I must keep track of those changes and adapt all my stored references, right?
from that point of view, the comments solution seems easier (although this is of course also not ideal, because the user can see/change it)
Freitag, 17. Mai 2013 10:47Moderator
Instead of saving adrresses you could use Names. In a light test this seemed to work for me: First run testAdd and then testGetData
Option Explicit Function GetXMLPart(sPart As String) As CustomXMLPart Dim xNode As CustomXMLNode Dim xPart As CustomXMLPart For Each xPart In ActiveWorkbook.CustomXMLParts If Not xPart.BuiltIn Then Set xNode = xPart.SelectSingleNode("/" & sPart) If Not xNode Is Nothing Then Set GetXMLPart = xPart Exit Function End If End If Next Set GetXMLPart = ActiveWorkbook.CustomXMLParts _ .Add(Replace("<#> </#>", "#", sPart)) End Function Sub testAdd() ' add values to B2:B6, name the cells, save names & values in the xml ' move the cells and clear their values Dim s As String Dim i As Long Dim cel As Range, rng As Range Dim nm As Name Dim xPart As CustomXMLPart Dim xNode As CustomXMLNode ' delete all previous test stuff GetXMLPart(s).Delete For Each nm In ActiveWorkbook.Names nm.Delete Next Cells.Clear s = "myData" Set xNode = GetXMLPart(s).SelectSingleNode(s) Set rng = Range("B2:B6") For Each cel In rng i = i + 100 Set nm = ActiveWorkbook.Names.Add("myData" & cel.Address(0, 0), cel) ' nm.Visible = False ' maybe hide from user cel.Value = i & " was in " & cel.Address(0, 0) xNode.AppendChildSubtree _ ("<Cell> <Name>" & cel.Name.Name & "</Name>" & _ "<V>" & cel.Value & "</V> </Cell>") Next ' delete the values and move the range ' Stop ' look at the sheet rng.Cut Range("B10") rng.Clear rng.Interior.Color = 1234567 End Sub Sub testGetData() ' put the original data back where it belongs Dim s$ Dim cel As Range Dim nm As Name s = "myData" Dim xNode As CustomXMLNode Dim xNodes As CustomXMLNodes Set xNodes = GetXMLPart(s).SelectNodes("/" & s & "/Cell") For Each xNode In xNodes Set cel = ActiveWorkbook.Names(xNode.SelectSingleNode("Name").Text).RefersToRange cel.Value = xNode.SelectSingleNode("V").Text Next End Sub
In the GetXMLPart function I'm sure there must be a more direct way to return the CustomXMLPart (if it exists) than testing if the given CustomXMLNode exists, if anyone has a better way?