Background
While developing a roadmap generator for Excel as discussed in a previous article on this forum , I realized that being able to manipulate the generated shapes, and as a result
have any changes in position be reflected in the source data, would not only
be an interesting problem to solve, but would also be very useful. This article
discusses how to solve the problem of embedding useful data in an Excel object,
and in the process will show how to create an arbitrary linked object structure
and how to serialize/deserialize data from this into JSON format. You can find
a downloadable example, which tracks workbook and form usage for illustration,
and maintains the data in JSON format concealed in both and Excel shape and a
hidden cell here.
Using JSON with VBA
Unfortunately, JSON and VBA are not made for each other in the way that say JSON
and javascript are. I did consider using XML (too heavy) or even some unstructured
format (too unpredictable and constrained), but in the end decided on JSON. The
first task then is to figure out how derialized JSON data will be accessed in
VBA procedures. This is done through a series of linked arbitrary objects which
are created during the deserialization process. The cJobject class implements
these as as follows
It's a pretty straightforward parent/child structure, with key/value property pairs,
which makes it ideal for recursion; which we will need to do in order to accommodate
the needs of a structure of indeterminate depth. The serialized version of the
data in the downloadable example provided looks like this
{"hiddendata": {"lastaccess": {"username": "fhk647","startedat": "2/1/2011 12:12:12 PM","finishedat":
"1/31/2011 7:39:21 PM"},"summary": {"timeopen": "17094","countopen": "5"}}}
... representing that pictorially we get this
The purpose of the example is simply to record a few items about the usage of a workbook
when it opens and closes, therefore the JSON data needs to be deserialized and
serialzed each time from it's hidden location in order to update these fields.
Accessing the cJobject data structure
This object can be created either by deserializing some JSON or by creating it directly
from cJobject methods. The following are some examples
set cj = new cJobject
' create a cJobject structure by deserialization
set cj = cj.Deserialize ( JSONstring)
' create the above object directly
set cj = new cJobject
cj.Init Nothing, "hiddendata"
With cj.Add "lastaccess"
.add "username"
.add "startedat"
.add "finishedat"
End With
With cj.Add "summary"
.add "timeopen"
.add "countopen"
End With
'Alternatively the same thing can be achieved as follows
set cj = new cJobject
With cj
.Init Nothing, "hiddendata"
.Add "lastaccess.username"
.Add "lastaccess.startedat"
.Add "lastaccess.finishedat"
.Add "summary.timeopen"
.Add "summary.countopen"
End With
' finally the whole thing can be serialized as
JSONstring = cj.Serialize
'In other words this should get you back to where you started
set cj = new cJobject
newJSONstring = cj.deserialize(JSONstring).serialize
You can see the full code of this class in the downloadable example, but here are
the properties and methods of interest
Public Property Get isValid() As Boolean
Public Property Get Parent() As cJobject
Public Property Get Root() As cJobject
Public Property Get Key() As String
Public Property Get Value() As Variant
Public Property Get Children() As Collection
Public Property Get hasChildren() As Boolean
Public Property Get asLong() As Long
Public Property Get asDate() As Date
Public Property Get asString() As String
Public Property Get asDouble() As Double
Public Property Get asBoolean() As Boolean
Public Sub init(p As cJobject, Optional k As String = "_null", Optional v As Variant = Empty)
Public Function Child(s As String) As cJobject
Public Function Add(k As String, Optional v As Variant = Empty) As cJobject
Public Function ChildExists(s As String) As cJobject
Public Function fullKey() As String
Public Function Serialize() As String
Public Property Get formatData() As String
Public Function deSerialize(s As String) As cJobject
Private Function dsProcess(job As cJobject, Optional whatNext As String = "{") As cJobject
As mentioned previously, recursion is required everywhere with this kind of structure.
As an example, here is the serialization method.
Public Function Serialize() As String
' make a JSON string of this structure
Serialize = "{" & recurseSerialize(Me) & "}"
End Function
Public Function recurseSerialize(job As cJobject, Optional soFar As String = "") As String
Dim s As String, jo As cJobject
s = soFar & quote(job.Key) & ": "
If Not job.hasChildren Then
s = s & quote(CStr(job.Value))
Else
s = s & "{"
For Each jo In job.Children
s = recurseSerialize(jo, s) & ","
Next jo
s = Left(s, Len(s) - 1) & "}"
End If
recurseSerialize = s
End Function
You may notice that I have implemented only enough of the JSON serialization to cover
my needs (only string format, no arrays) and of course to generate valid JSON
that can be used elsewhere. There are still a few things to implement which I
may do in the future for more general use.
Hiding the serialized data in Excel objects
Now that we have a mechanism for coding and decoding arbritary data, let's turn to
the topic of where to store it. In the example provided, I store it in both a
shape and in a hidden cell. You will see from the code shortly that there is
very little difference in implementation. For my Roadmap Generator I intend to
hide this data in the .AlternativeText property of each shape. This give me the
added benefit of being able to access the source data when the shape is copied
into another application such as Powerpoint and since .AlternativeText is little
used, it seems like a good target. If you are tracking form or worksheet usage,
it might be better to use a hidden cell. Here is the example implementation
'Storing it in a Shape
Sub wbOpenShapeVersion()
'workbook has opened
With Sheets(hiddenShapeSheet).Shapes(hiddenShape)
.AlternativeText = openingData(CStr(.AlternativeText)).Serialize
End With
End Sub
Sub wbCloseShapeVersion()
'workbook is closing - get data if it exists from the hidden shape
With Sheets(hiddenShapeSheet).Shapes(hiddenShape)
.AlternativeText = closingData(CStr(.AlternativeText)).Serialize
End With
End Sub
'Storing it in a cell
Sub CloseCellVersion(sr As String)
With Range(sr)
.Value = closingData(CStr(.Value)).Serialize
End With
End Sub
Sub OpenCellVersion(sr As String)
With Range(sr)
.Value = openingData(CStr(.Value)).Serialize
End With
End Sub
'Common to both - the specific data to be stored for your application
Private Function openingData(s As String) As cJobject
' create serialization object
Dim cj As cJobject
Set cj = New cJobject
Set cj = cj.deSerialize(s)
If cj.Key <> cKeyName Or Not cj.isValid Then
Set cj = New cJobject
cj.init Nothing, cKeyName
End If
' setup the data relevant to opening
With cj.Add("lastaccess")
.Add ("username"), Environ("USERNAME")
.Add ("startedat"), Now
End With
' will need these later so add them in case they dontr exist already
With cj.Add("summary")
.Add ("timeopen")
.Add ("countopen")
End With
Set openingData = cj
End Function
Private Function closingData(s As String) As cJobject
' create serialization object
Dim cj As cJobject
Set cj = New cJobject
Set cj = cj.deSerialize(s)
If cj.Key <> cKeyName Or Not cj.isValid Then
Set cj = New cJobject
cj.init Nothing, cKeyName
End If
' setup the data relevant to closing
With cj.Add("lastaccess")
.Add ("finishedat"), Now
End With
If cj.isValid Then
With cj.Add("summary")
.Add ("timeopen"), .Child("timeopen").asLong _
+ DateDiff("s", cj.Child("lastaccess.startedat").Value, Now())
.Add ("countopen"), .Child("countopen").asLong + 1
End With
End If
Set closingData = cj
End Function
Summary
This article brings together the work from two previous articles on this forum -
Serializing Excel data for input to any Google visualization and Excel Generate High Quality RoadMaps to provide a some capabilities required to start using JSON effortlessly within
VBA and also to be able to pass arbritary data around inside Excel Objects. In
a future article I will cover how to create and handle events in shapes generated
programatically in VBA, and apply the tools from this article to access source
data embedded within shapes. As always I welcome suggestions, improvements, questions
and bug fixes at excel@mcpher.com. All code in this article is free to use as
you wish for non commercial use and can be downloaded from here