Deprecated
Google has now stopped its Earth API and Maps API is a paid for API nowadays. Some capabilities have also been either removed or changed. Therefore, I had to remove all examples of VizMap applications I had created. I didn’t remove the entire topic as I thought some of the code may still be useful with some modifications.
VizMap: the vba to generate vizMap application
This relates to Data Driven Mapping applications
For this example I had created a Concerts/Venues example that is now deprecated. The complete workbook (googlemapping.xlsm) can be downloaded (above) and the example Parameter WorkSheet is called VenuesParameters.
Generating the application
Generating the application will take the parameter data to create a jSon framework, and the data in the venuesMapping sheet to create the jSon data, and wrap it all up in the predefined javaScript found in the geoCoding parameter sheet, along with the application specific html in the venuesParameter sheet.
vba walkthrough
The code can be found in the vizExamples module.
-
- Load the parameter sheets, dSetsSetup plus the additional framework parameter blocks needed for this phase, vizdSetsSetup
- Check that all fields mentioned anywhere in the framework exist in the data, allFieldsPresent
- Create a heirarchical cJobject to hold the framework
- Add the dictionary, measures, tabs and elements. This is just a translation from cDataSet cells to cJobject nodes.
- Now create the cJobject to hold the data
- Use the Dictionary object to find the required data in the venuesMapping dataset and add each object and its value
- Create an html file, generateVizHtml, which takes each of the code components from the parameter sheets and combines that with a jSon serialization of both the framework and data cJobjects.
- Start up a browser if required and run the generated application pickABrowser dSets, fName
complete vba for vizExamples module
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 |
' assume we've geocoded and run the ordersjoining example - this is the input to this 'for more about this ' https://ramblings.mcpher.com/classes/datamanip/ 'to contact me ' https://gitter.im/desktopliberation/community 'reuse of code ' https://ramblings.mcpher.com/reusing-code-from-this-site/ Option Explicit ' application 1 Public Sub vizOrders() googleMarkingViz (cVizAppOrders) End Sub ' application 2 Public Sub vizVenues() googleMarkingViz (cVizAppVenues) End Sub ' application 3 Public Sub vizPalaces() googleMarkingViz (cVizAppPalaces) End Sub ' application 4 Public Sub vizOrg() googleMarkingViz (cVizAppOrg) End Sub ' application 5 Public Sub vizFamily() googleMarkingViz (cVizAppFamily) End Sub Public Sub googleMarkingViz(paramName As String) Dim dSets As cDataSets, dc As cCell, job As cJobject, fName As String Dim dr As cDataRow, jo As cJobject, drtab As cDataRow, joe As cJobject Dim joc As cJobject, a As Variant, i As Long, jod As cJobject Dim eOutput As eOutputMarkers eOutput = eOutputHtml Set dSets = dSetsSetup(paramName) If dSets Is Nothing Then Exit Sub vizdSetsSetup paramName, dSets ' check that we have the required marker fields If Not ( _ allFieldsPresent(dSets, cTab, cTableFields, cJoin, True) And _ allFieldsPresent(dSets, cTab, cFilterFields, cJoin, True) And _ allFieldsPresent(dSets, cTab, cChartFields, cJoin, True) And _ allFieldsPresent(dSets, cTab, cTwitterFields, cJoin, True) And _ allFieldsPresent(dSets, cSpots, cControlValue, cJoin, True) And _ allFieldsPresent(dSets, cDictionary, cMatch, cJoin, , False)) Then Exit Sub ' we have it all now create a job Set job = New cJobject ' create the Tabs With job.init(Nothing, "framework") With .add("dictionary") For Each dr In dSets.DataSet(cDictionary).Rows .add dr.Cell(cDictionary).toString, _ dSets.DataSet(cJoin).Column(dr.Cell(cMatch).toString).googleType Next dr End With End With ' create the frameworl With job With .add("measures") For Each dr In dSets.DataSet(cMeasure).Rows .add dr.Cell(cMeasure).toString, dr.Cell(cOperation).toString Next dr End With With .add("control") For Each dr In dSets.DataSet(cLocalControl).Rows .add dr.Cell(cControl).toString, dr.Cell(cControlValue).toString Next dr End With With .add("tabs") For Each dr In dSets.DataSet(cTab).Rows Set jod = .add(dr.Cell(cTab).toString) addList jod, cFilterFields, dr, "filter" addList jod, cChartFields, dr, "chart" addList jod, cTableFields, dr, "table" addList jod, cTwitterFields, dr, "twitter" jod.add "image", dr.Cell(cImage).toString jod.add "charttype", dr.Cell(cChartType).toString Next dr End With With .add("elements") For Each dr In dSets.DataSet(cElement).Rows With .add(LCase(dr.Cell(cElement).toString)) .add "position", dr.Cell(cPosition).toString .add "show", dr.Cell(cShow).toString End With Next dr End With With .add("spots") For Each dr In dSets.DataSet(cSpots).Rows .add dr.Cell(cSpots).toString, dr.Cell(cControlValue).toString Next dr End With End With ' create the data Set joe = New cJobject With joe.init(Nothing, "data") With .add("cJobject").AddArray For Each dr In dSets.DataSet(cJoin).Rows With .add For Each jo In job.Child("dictionary").Children .add jo.key, dr.Cell( _ dSets.DataSet(cDictionary).Cell(jo.key, cMatch).toString _ ).toString Next jo End With Next dr End With End With ' now create the html file and browse to it fName = dSets.DataSet(cSpecificViz).Cell("filename", "code").toString Select Case eOutput Case eOutputHtml If openNewHtml(fName, generateVizHtml(job, joe, dSets)) Then pickABrowser dSets, fName, , cLocalControl End If Case Else Debug.Assert False End Select Set dSets = Nothing End Sub Private Function generateVizHtml(joFrame As cJobject, joData As cJobject, _ dSets As cDataSets) As String Dim s1 As String, s2 As String ' the deserialized data s1 = "//---Excel generated framework" & vbLf & _ "function mcpherGetFramework () " & vbLf & _ " { return (" & vbLf & joFrame.Serialize(True) & vbLf & " ) ; }" & vbLf & _ "//---ramblings.mcpher.com" s2 = "//---Excel generated data" & vbLf & _ " function mcpherGetData () " & vbLf & _ " { return (" & vbLf & joData.Serialize(True) & vbLf & " ) ; }" & vbLf & _ "//---ramblings.mcpher.com" With dSets.DataSet(cSpecificViz) generateVizHtml = _ .Cell("header", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherinit", "code").toString & vbLf _ & s1 & vbLf & s2 & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcphervizmap", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherinfotab", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpheritem", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherspot", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherearth", "code").toString & vbLf _ & dSets.DataSet(cMarkerViz).Cell("mcpherfunctions", "code").toString & vbLf _ & .Cell("body", "code").toString & vbLf End With End Function Private Function allFieldsPresent(dSets As cDataSets, _ blockName As String, columnName As String, _ dataName As String, Optional allowBlank As Boolean = False, _ Optional useDictionary As Boolean = True) As Boolean Dim dc As cCell, dd As cCell, a As Variant, i As Long, S As String allFieldsPresent = False With dSets For Each dc In .DataSet(blockName).Column(columnName).Rows If (Not allowBlank Or dc.toString <> vbNullString) Then a = Split(dc.toString, ",") For i = LBound(a) To UBound(a) S = a(i) If useDictionary Then Set dd = .DataSet(cDictionary).Cell(S, cMatch) If (dd Is Nothing) Then MsgBox ("cannot find in dictionary " & S & " needed by " & blockName) Else With .DataSet(dataName).HeadingRow If Not .Validate(True, dd.toString) Then Exit Function End With End If Else With .DataSet(dataName).HeadingRow If Not .Validate(True, S) Then Exit Function End With End If Next i End If Next dc End With allFieldsPresent = True End Function |
Questions, feedback and VizMap applications you have generated can be submitted for loading to this site via our forum. Now let’s look at VizMap javaScript, the generated application.