In Hiding data in Excel Objects I introduced the concept of hiding data in shapes by encoding it into jSon, then hiding the serialized result in a property of a hidden shape. One of the common uses of this to enable data persistence between calls to a userForm.
Private Sub UserForm_Activate() ' this will fill in any default values from the last time this form was used Dim cp As New cPersistence cp.getForm Me End Sub Private Sub UserForm_Deactivate() ' this will store default values for the next time Dim cp As New cPersistence cp.saveForm Me End Sub Private Sub UserForm_Terminate() UserForm_Deactivate End Sub
{ "ramblings_mcpher_com_persistent_shape":{ "Label1":"Label1", "TextBox1":"first time", "TextBox2":"i filled this and checked that", "CheckBox1":"True", "CommandButton1":"False" } }
Option Explicit Private Sub deleteShape() Dim c As New cPersistence c.deleteShape End Sub
' saves persistent data hidden in a workbook Public Function shapeItem() As shape ' this retrieves the shape thats being used as a storage area or creates it Set shapeItem = findOrCreate() End Function Public Function deleteShape() Dim s As shape ' get rid of the whole thing Set s = findShape If Not s Is Nothing Then s.Delete End If End Function Public Property Get shapeName() As String ' the name to use for the persistent shape shapeName = "ramblings_mcpher_com_persistent_shape" End Property Private Function findOrCreate() ' either find an existing shape or make a new one Dim s As shape Set s = findShape() If s Is Nothing Then Set s = createShape() End If Set findOrCreate = s End Function Private Function createShape() As shape ' create an empty shape Dim s As shape With ActiveSheet Set s = .Shapes.AddShape(msoShapeRectangle, 1, 1, 1, 1) s.Visible = False s.name = shapeName() End With Set createShape = s End Function Public Function findShape() As shape ' could be anywhere in the workbook Dim ws As Object, s As shape For Each ws In Sheets With ws For Each s In .Shapes If s.name = shapeName Then Set findShape = s Exit Function End If Next s End With Next ws Set findShape = Nothing End Function Public Function getForm(f As UserForm) As cJobject ' get the persistent form data, and populate the form with it Dim cj As cJobject, o As Control, jo As cJobject Set cj = getJob If Not cj Is Nothing Then For Each o In f.Controls Set jo = cj.child(o.name) If (Not jo Is Nothing) Then setControlValue o, jo.Value End If Next o End If End Function Public Function saveForm(f As UserForm) As cJobject 'save the persistent form data to the hidden shape shapeItem.AlternativeText = makeJob(f).serialize() End Function Public Function getJob() As cJobject ' get the persistent form data from the hidden shape Dim cj As cJobject, s As shape Set s = shapeItem() If (s.AlternativeText <> vbNullString) Then Set cj = New cJobject Set cj = cj.init(Nothing).deSerialize(s.AlternativeText).Children(1) End If Set getJob = cj End Function Public Function makeJob(f As UserForm) As cJobject ' save all the current values of every control in a form Dim o As Control, cj As cJobject Set cj = New cJobject cj.init Nothing, shapeName() For Each o In f.Controls cj.add o.name, getControlValue(o) Next o Set makeJob = cj End Function
bruce mcpherson is licensed under a Creative Commons Attribution-ShareAlike 4.0 International License. Based on a work at http://www.mcpher.com. Permissions beyond the scope of this license may be available at code use guidelines