Excel to App (with VBA macros)

This is a continuation (or better, a prologue) of this post, where I’m trying to accomplish an “Excel to web App” solution that can handle macros (VBA to JavaScript). It’s only shown a little piece of code on how to get an “If” block to JS, but there is more done waiting to create an online service to be published.

An introduction

I’ve looking around to jump out from Excel environment. I feel very confortable in Excel and the RAD VBA it provides, but it only rides on Excel, and one critical point is that I can’t share any development with enough confidence to not beeing shredded and copied out. As I’ve done lots on Excel, if I need to port, I’ll need a solution not time consuming, so this leads me that I’m not to learn any compilable language, if possible. Looks like a “translator” will be a good solution, one that lets me run Macros, not rely only on Excel formulas. This point, on it’s one, should opt the way to go. First thought came to translate VBA to any other language and then manage the GUI. I could not find any translator for the code, not even between VBA an VB6… There is another problem, that is I need the solution to be “universal”, and moving to a compilable solution will arise the EXEcentric problem. Going a little further, but still with the no-code intention, I wondered if an Excel spreadsheet can be turn into a native mobile app (iOS or Android). There are not so many options out there to achieve this (footnote 1), but here I find with some handicaps:
  • An EXEcentric problem again (new flavour). You mostly will be tied to the specific platform you are converting the app to (in the future… Fuchsia, hello?)
  • With the actual commercial solutions you have not a lot of control on the output app… they mostly turn the spreadsheet to a kiddish app, and it’s hard to tune the GUI.
  • If you need a database, you even have less options to control who stores your data, as they are usually bound to the provider of the app converter engine.
  • Lets face it, NO Macros at all.
Then I started to consider a web/HTML5 approach, and things started to get interesting:
  • It can run on any device, independently of the underneath OS.
  • HTML5 is way easier to tune. Once the system is mounted, and you can separate the GUI from the under the hood solution, beautifying the app is only a matter of the time you put on it, and it does not have to be that much.
  • If you want, you have more control over your shared data, going on your own or relying on a professional cloud solution.
  • No Macros problem again. None of the converters out there offer Macros handling, and although there are a pleyade of technologies you can rely on to get things done, you will have to learn and code a lot.
So, at the end, I was stuck with the VBA Macros subject. It is pretty clear that there is a need for a VBA to JavaScript translator, that would put things where they should. The only approximation I could find is this one, but lucky me… it’s not working and it looks like it will never do. But, VBA and EMACS6 do not differ a lot from each other, you know, they manage a DOM object (worksheet/workbook or a web sheet), they do have If, Do-Loop, For, Switch statements, have classes and nearly objects. They have similarities (footnote 2). And here is the final solution to which I arrived… (yet to publish). If you are interested, please contact me while the solution is not published In the interim, I needed to go from an HTML structure to a UDTish VBA structure, so here is a parser for the HTML code, so it can be programed in blocks instead than dealing with the HTML code. The code piece shown here works to do some pretty things (clean clode to the tag expression), and most of the procedures can be reused to other purposes, but it’s still not in the final version (90% done)… that would be identifying and grouping items in blocks.
Option Explicit

Private Type tAttrib
Attrib As String
Value As String
End Type
Private Type tPair
Main As Long
Global As Long
End Type
Private Type tTag
Tag As String
Class As String
ID As String
Name As String
Attrib() As tAttrib
InnerText As String
Child() As tPair
Deepness As Long
Start As Long
End As Long
End Type
Private Type tFormula
Formula As String
Address As String
End Type

Private aTag() As tTag
Private aTmpTag() As tTag
Private myTag As tTag
Private aCode() As String

Private Type tPtrTag
Tag As String
Level As Long
Main As Long
End Type
Private PtrTag() As tPtrTag

Public Sub sHTML_To_VBA()
' Given site HTML code, get as VBA code

'!!!!!! move to module declarations?
'!!!!!!
Dim aCode_Out() As String
Dim strPathFile_HTML5 As String
Dim strCode As String
Dim strLine As String
Dim strLine_Out As String
Dim strText As String
Dim lgLine As Long
Dim lgPos As Long
Dim lgChr As Long
Dim lgLineLen As Long

strPathFile_HTML5 = "File.htm" '--> here your file
'strCode = fGetCode(, , strPathFile_HTML5)
'This fGetCode gets all string in the file
Dim iFileVB As Integer
strCode = VBA.Space$(VBA.FileLen(strPathFile_HTML5))
iFileVB = VBA.FreeFile()
Open strPathFile_HTML5 For Binary As #iFileVB
Get #iFileVB, 1, strCode
Close #iFileVB
strCode = Replace(strCode, vbCrLf, vbLf)
aCode() = VBA.Split(strCode, vbLf)
aCode_Out() = aCode()
strCode = vbNullString ' free memory

For lgLine = LBound(aCode) To UBound(aCode)
strLine = aCode(lgLine)
If VBA.Trim$(strLine) = vbNullString Then
strLine = vbNullString
Else
lgLineLen = VBA.Len(strLine)

' delete all losen spaces after "=" operator - fast and dirty solution ;)
If VBA.InStr(1, strLine, "= ") Then
lgPos = VBA.InStr(1, strLine, "= ") + 1
' find the end of the text string
lgChr = lgPos
Do
lgChr = lgChr + 1: If lgChr > VBA.Len(strLine) Then Exit Do
Loop Until VBA.Mid$(strLine, lgChr, 1) Like "[',"",A-Z,a-z,0-9]"

' Avoid all spaces between the scape char combination
strLine = VBA.Mid$(strLine, 1, lgPos - 1) & VBA.Mid$(strLine, lgChr)
End If
'Do While VBA.InStr(1, strLine, "= ")
' strLine = VBA.Replace(strLine, "= ", "=")
'Loop

' if comment, get strBounder [',"] --> if contains the other strBounder, then --> switch strBounder = [']
'If VBA.InStr(1, strText, """") Then
'If VBA.InStr(1, strText, "'") = 0 Then strBounder = "'" Else strBounder = """"

' replace all " chars inside strings - fast and dirty solution ;)
Do While VBA.InStr(1, strLine, "=""")
lgPos = VBA.InStr(1, strLine, "=""") + 1
' find the end of the text string
lgChr = lgPos
Do
lgChr = lgChr + 1: If lgChr > VBA.Len(strLine) Then Exit Do
If VBA.Mid$(strLine, lgChr - 1, 2) Like "\""" Then
strLine = VBA.Mid$(strLine, 1, lgChr - 1) & "§" & VBA.Mid$(strLine, lgChr + 1)
End If
Loop Until VBA.Mid$(strLine, lgChr, 1) Like """"

' Replace all " inside text with the scape char combination
strText = VBA.Mid$(strLine, lgPos, lgChr - lgPos + 1)
If VBA.InStr(1, strText, "'") > 0 Then
strText = VBA.Replace(strText, "\'", "\§")
strText = VBA.Replace(strText, "'", "\§")
End If
If VBA.InStr(1, strText, " 0 Then
strText = VBA.Replace(strText, "\<", "\\•")
strText = VBA.Replace(strText, "") > 0 Then
strText = VBA.Replace(strText, "\>", "\\¤")
strText = VBA.Replace(strText, ">", "\¤")
End If
If VBA.InStr(1, strText, "=") > 0 Then
strText = VBA.Replace(strText, "\¡", "\\¡")
strText = VBA.Replace(strText, "=", "\¡")
End If
strLine = VBA.Mid$(strLine, 1, lgPos - 2) & "¨" & strText & VBA.Mid$(strLine, lgChr + 1)
Loop

Do While VBA.InStr(1, strLine, "='")
lgPos = VBA.InStr(1, strLine, "='") + 1
' find the end of the text string
lgChr = lgPos
Do
lgChr = lgChr + 1
If VBA.Mid$(strLine, lgChr, 1) Like "\" Then
If VBA.Mid$(strLine, lgChr + 1, 1) Like "'" Then ' Replace ' scape char with \§ scape combination
'If VBA.Mid$(strLine, lgChr - 1, 2) Like "\'" Then
' strLine = VBA.Mid$(strLine, 1, lgChr - 1) & "§" & VBA.Mid$(strLine, lgChr + 1)
strLine = VBA.Mid$(strLine, 1, lgChr) & "\§" & VBA.Mid$(strLine, lgChr + 2)
lgChr = lgChr + 1
End If
End If
Loop Until VBA.Mid$(strLine, lgChr, 1) Like "'"

' Replace all " inside text with the scape char combination
strText = VBA.Mid$(strLine, lgPos, lgChr - lgPos + 1)
If VBA.InStr(1, strText, """") > 0 Then
strText = VBA.Replace(strText, "\""", "\¶")
strText = VBA.Replace(strText, """", "\¶")
End If
If VBA.InStr(1, strText, " 0 Then
strText = VBA.Replace(strText, "\<", "\\•")
strText = VBA.Replace(strText, "") > 0 Then
strText = VBA.Replace(strText, "\>", "\\¤")
strText = VBA.Replace(strText, ">", "\¤")
End If
If VBA.InStr(1, strText, "=") > 0 Then
strText = VBA.Replace(strText, "\¡", "\\¡")
strText = VBA.Replace(strText, "=", "\¡")
End If
strLine = VBA.Mid$(strLine, 1, lgPos - 2) & "¨" & strText & VBA.Mid$(strLine, lgChr + 1)

strLine = VBA.Replace(strLine, """", "'") ' switch " with ' (string bounders)
Loop

Do While VBA.InStr(1, strLine, "=")
lgPos = VBA.InStr(1, strLine, "=") + 1
' find the end of the text string
lgChr = lgPos
Do
lgChr = lgChr + 1
If VBA.Mid$(strLine, lgChr, 1) Like "\" Then
If VBA.Mid$(strLine, lgChr + 1, 1) Like "'" Then ' Replace ' scape char with \§ scape combination
'If VBA.Mid$(strLine, lgChr - 1, 2) Like "\'" Then
' strLine = VBA.Mid$(strLine, 1, lgChr - 1) & "§" & VBA.Mid$(strLine, lgChr + 1)
strLine = VBA.Mid$(strLine, 1, lgChr) & "\§" & VBA.Mid$(strLine, lgChr + 2)
lgChr = lgChr + 1
End If
End If
Loop Until VBA.Mid$(strLine, lgChr, 1) Like "[]" 'lgChr >= lgLineLen

' Replace all " inside text with the scape char combination
strText = VBA.Mid$(strLine, lgPos, lgChr - lgPos + 1)
If VBA.InStr(1, strText, """") > 0 Then
strText = VBA.Replace(strText, "\""", "\¶")
strText = VBA.Replace(strText, """", "\¶")
End If
If VBA.InStr(1, strText, " 0 Then
strText = VBA.Replace(strText, "\<", "\\•")
strText = VBA.Replace(strText, "") > 0 Then
strText = VBA.Replace(strText, "\>", "\\¤")
strText = VBA.Replace(strText, ">", "\¤")
End If
If VBA.InStr(1, strText, "=") > 0 Then
strText = VBA.Replace(strText, "\¡", "\\¡")
strText = VBA.Replace(strText, "=", "\¡")
End If
strLine = VBA.Mid$(strLine, 1, lgPos - 2) & "¨" & strText & VBA.Mid$(strLine, lgChr + 1)

strLine = VBA.Replace(strLine, """", "'") ' switch " with ' (string bounders)
Loop

strLine = VBA.Replace(strLine, """", "'") ' """ & """""""""" & """)

'------
strLine_Out = strLine
strLine_Out = VBA.Replace(strLine_Out, "\¶", "\""") ' restore " chars in string
strLine_Out = VBA.Replace(strLine_Out, "\§", "\'") ' restore ' chars in string
strLine_Out = VBA.Replace(strLine_Out, "\\•", "\<") ' restore \< chars in string
strLine_Out = VBA.Replace(strLine_Out, "\•", "<") ' restore ") ' restore \> chars in string
strLine_Out = VBA.Replace(strLine_Out, "\¤", ">") ' restore > chars in string
strLine_Out = VBA.Replace(strLine_Out, "¨", "=") ' restore > chars in string
strLine_Out = VBA.Replace(strLine_Out, "\¡", "=") ' restore > chars in string
'------
End If

' Compare: Debug.Print aCode(lgLine) & vbLf & strLine_Out
aCode(lgLine) = strLine ' cleaned for parsing
aCode_Out(lgLine) = strLine_Out ' switch bounders
Next lgLine

' Rigth now we have all strings delimited by "'" bounders
strCode = VBA.Join(aCode_Out(), vbLf)
Erase aCode_Out()

' Print out code
strCode = VBA.Replace(strCode, vbLf, """ & vbLf _" & vbLf & VBA.Space(18) & "& """)
strCode = VBA.Replace(strCode, _
VBA.Space(18) & "& """""" _" & vbLf & VBA.Space(18) & "& """, _
VBA.Space(18) & "& """"""" & vbLf & "strHTML = strHTML & """)

strCode = VBA.Replace(strCode, _
VBA.Space(18) & "& """" & vbLf _", _
VBA.Space(18) & "& vbLf" & vbLf & "strHTML = strHTML _")

' opener and ender:
strCode = "strHTML = strHTML & """ & strCode & """"

Dim iFileOut As Integer
iFileOut = VBA.FreeFile()
Open strPathFile_HTML5 & "(1).htm" For Output Shared As #iFileOut
Print #iFileOut, strCode
Close #iFileOut
strCode = vbNullString ' Free memory

Call sHTML_To_Structure(aCode())
End Sub

Public Sub sHTML_To_Structure(ByRef aCode() As String)
'ToDo: we should rip off script blocks, style blocks and HTML comments
Dim myTagNew As tTag
Dim aComment() As tTag
Dim aStyle() As tTag
Dim aScript() As tTag
Dim lgScript As Long: lgScript = -1
Dim lgStyle As Long: lgStyle = -1
Dim lgComment As Long: lgComment = -1

' --- get template

Dim aTagAutocontained As Variant
aTagAutocontained = Array("!--", "!doctype", "area", "base", "basefont", "br", "col", "embed", "hr", "img", "input", "meta", "link", "param", "source", "track")
Dim oTag As Variant
Dim bAvoid As Boolean
Dim strCode As String
Dim strTag As String
Dim lgTag As Long
Dim lgChild As Long
Dim strLine As String
Dim strChr As String
Dim lgLine As Long
Dim lgLineRange As Long
Dim lgLineStart As Long
Dim lgLineEnd As Long
Dim lgAttrib As Long
Dim strTagNext As String
Dim lgRetVal As Long
Dim bRipOff As Boolean
Dim lgLineRipOff As Long
Dim lgTmpTag As Long
Dim lgLevel As Long
Dim lgLevelMax As Long
Dim bNewTag As Boolean

Dim lgLineDeep As Long
Dim PtrDone() As Boolean
Dim PtrChild() As Long

' for attributes/elements
strCode = VBA.Join(aCode(), vbLf)
aCode() = VBA.Split(strCode, "<") ' split for parsing (will break in all items)
ReDim PtrTag(LBound(aCode) To UBound(aCode))
ReDim PtrChild(LBound(aCode) To UBound(aCode))
ReDim PtrDone(LBound(aCode) To UBound(aCode))
ReDim aTmpTag(LBound(aCode) To UBound(aCode))

'!!!!!!!!!!!!!!!!
' Delete free spaces and continue lines??
'For lgLine = LBound(aCode) To UBound(aCode)
' aCode(lgLine) = VBA.Trim$(aCode(lgLine))
' aCode(lgLine) = VBA.Replace(aCode(lgLine), vbLf, " ")
'Next lgLine
'!!!!!!!!!!!!!!!!

'Get Tag and level for each line
Erase aTag()
lgTag = -1
lgLevel = 0
For lgLine = LBound(aCode) To UBound(aCode)
strLine = VBA.LCase$(VBA.Trim$(aCode(lgLine)))

If VBA.Trim$(strLine) vbNullString Then ' Avoid first line...
If strLine Like "/*" Then
strTag = fTag(strLine, False)
PtrTag(lgLine).Tag = "/" & strTag
PtrTag(lgLine).Level = lgLevel
lgLevel = lgLevel - 1
If lgLevel = 0 Then Exit For
Else
strTag = fTag(strLine, True)
PtrTag(lgLine).Tag = strTag

aTmpTag(lgLine) = fTagGet(lgLine) 'get attributes and internal text..., but not the childs

' Level: avoid autocontained HTML tags
bAvoid = False
For Each oTag In aTagAutocontained
If strTag Like oTag Then
bAvoid = True
Exit For
End If
Next oTag

If bAvoid Then
PtrTag(lgLine).Level = -(lgLevel + 1)
Else
lgLevel = lgLevel + 1
PtrTag(lgLine).Level = lgLevel
End If
End If
End If
Next lgLine

' For each tag, get range
For lgLine = LBound(aCode) To UBound(aCode)
If VBA.Trim$(aCode(lgLine)) vbNullString Then ' Avoid first line...
With aTmpTag(lgLine)
.Start = lgLine
.End = lgLine
If PtrTag(.Start).Level >= 0 Then ' not autocontained
If PtrTag(.Start).Tag Like "/*" Then
Do Until PtrTag(.Start).Level = PtrTag(.End).Level _
And PtrTag(.End).Tag = "/" & PtrTag(.Start).Tag
.Start = .Start - 1
Loop
ElseIf Not PtrTag(.Start).Tag Like "/*" Then
' not closing
Do Until PtrTag(.Start).Level = PtrTag(.End).Level _
And PtrTag(.End).Tag = "/" & PtrTag(.Start).Tag
.End = .End + 1
Loop
End If
End If
End With
End If
Next lgLine

' 'lgRetVal = VBA.MsgBox("We have reached the end of code without closing the living TAG..." & vbLf & _
' "Check tag [" & strTag & "] starting at line:" & lgLine, _
' vbCritical, "W A R N I N G")

'Stop
' rip off dispensable tags
For lgLine = LBound(aCode) To UBound(aCode)
If PtrTag(lgLine).Tag = "!--" Then
bRipOff = True
lgLineRipOff = lgLine
' End "-->"
Do
lgComment = lgComment + 1
ReDim Preserve aComment(0 To lgComment)

strLine = aCode(lgLineRipOff)
If VBA.InStr(1, strLine, "-->") Then
' move the comment part to aComment(lgComment)
aComment(lgComment).InnerText = VBA.Mid$(strLine, 4, VBA.InStr(1, strLine, "-->") - 4)
Exit Do
Else
' move entire line to aComment(lgComment)
aComment(lgComment).InnerText = strLine
End If
lgLine = lgLine + 1: If lgLine > UBound(aCode) Then Exit Do
Loop While bRipOff

' store line on .Deepness
aComment(lgComment).Deepness = lgLine

ElseIf PtrTag(lgLine).Tag = "script" Then
lgScript = lgScript + 1
ReDim Preserve aScript(0 To lgScript)
aScript(lgScript) = fTagGet(lgLine, False)

' store line on .Deepness
aScript(lgScript).Deepness = lgLine

ElseIf PtrTag(lgLine).Tag = "style" Then
lgStyle = lgStyle + 1
ReDim Preserve aStyle(0 To lgStyle)
aStyle(lgStyle) = fTagGet(lgLine, False)

' store line on .Deepness
aStyle(lgStyle).Deepness = lgLine

End If
Next lgLine

' Filter to get only the "main" tags
'Stop
Call fTagMain

' Get childs
For lgTmpTag = LBound(aCode) To UBound(aCode)
'strLine = aCode(lgTmpTag)
If PtrTag(lgTmpTag).Level > 0 Then
If Not PtrTag(lgTmpTag).Tag Like "/*" Then
lgChild = -1
For lgLine = (aTmpTag(lgTmpTag).Start + 1) To aTmpTag(lgTmpTag).End
If PtrTag(lgLine).Level > 0 Then
If Not PtrTag(lgLine).Tag Like "/*" Then
If PtrTag(lgLine).Level = (PtrTag(lgTmpTag).Level + 1) Then
'strLine = aTag(PtrTag(lgLine).Main).Tag
lgChild = lgChild + 1
ReDim Preserve aTmpTag(lgTmpTag).Child(0 To lgChild)
aTmpTag(lgTmpTag).Child(lgChild).Main = PtrTag(lgLine).Main
aTmpTag(lgTmpTag).Child(lgChild).Global = lgLine
End If
End If
End If
Next lgLine
End If
End If
Next lgTmpTag

'------------------------------

Stop
'Print the structure
Call fTagPrint(lgTmpTag:=2)
Stop
End Sub

Private Function fTagPrint(Optional ByVal lgTmpTag As Long) As Boolean
Dim lgR As Long
Dim lgLevel As Long

'Cells.Delete
lgR = 0
lgTmpTag = 2
'For lgTmpTag = (LBound(aCode) + 1) To UBound(aCode)
If PtrTag(lgTmpTag).Tag Like "/*" Then
lgR = lgR + 1
lgLevel = VBA.Abs(PtrTag(lgTmpTag).Level)
Cells(lgR, lgLevel).Value2 = PtrTag(lgTmpTag).Tag
Else
lgR = lgR + 1
lgLevel = VBA.Abs(PtrTag(lgTmpTag).Level)
Cells(lgR, lgLevel).Value2 = PtrTag(lgTmpTag).Tag
If Not (Not aTmpTag(lgTmpTag).Child) Then
Call fChildPrint(lgR, lgTmpTag)
End If
End If
'Next lgTmpTag
End Function

Private Function fChildPrint(ByRef lgR As Long, _
ByVal lgTag As Long) As Boolean
Dim lgLevel As Long
Dim lgParent As Long
Dim lgChild As Long
Dim lgMain As Long

If Not (Not aTmpTag(lgTag).Child) Then
For lgParent = LBound(aTmpTag(lgTag).Child) To UBound(aTmpTag(lgTag).Child)
lgR = lgR + 1
lgLevel = VBA.Abs(PtrTag(lgTag).Level)
lgMain = aTmpTag(lgTag).Child(lgParent).Main
lgChild = aTmpTag(lgTag).Child(lgParent).Global
Cells(lgR, lgLevel + 1).Value2 = aTag(lgMain).Tag

'If aTag(lgMain).Tag Like "i" Then Stop
If Not (Not aTmpTag(lgChild).Child) Then
Call fChildPrint(lgR, lgChild)
End If
Next lgParent
End If
End Function

Private Function fTagMain() As tTag()
' Get only the "main" tags
Dim lgTmpTag As Long
Dim lgTag As Long
Dim lgTagMatch As Long
Dim bNewTag As Boolean

For lgTmpTag = LBound(aTmpTag) To UBound(aTmpTag)
If aTmpTag(lgTmpTag).Tag vbNullString Then
If Not (Not aTag) Then
lgTag = UBound(aTag) + 1
lgTagMatch = fTagNew(lgTmpTag)
If lgTagMatch < 0 Then
bNewTag = True
Else
PtrTag(lgTmpTag).Main = lgTagMatch
bNewTag = False
End If
Else
bNewTag = True
lgTag = 0
End If

If bNewTag = True Then
ReDim Preserve aTag(0 To lgTag)
lgTagMatch = lgTmpTag
aTag(lgTag) = aTmpTag(lgTmpTag)
PtrTag(lgTmpTag).Main = lgTag
End If
End If
Next lgTmpTag
End Function

Private Function fTagNew(ByVal lgTmpTag As Long) As Long
Dim lgTag As Long
Dim lgAttrib As Long
Dim bNewTag As Boolean
Dim bMatchAttrib As Boolean
Dim aBoolChild() As Byte

bNewTag = False
bMatchAttrib = False
For lgTag = LBound(aTag) To UBound(aTag)
Erase aBoolChild()
If aTag(lgTag).Tag = aTmpTag(lgTmpTag).Tag Then
If aTag(lgTag).Class = aTmpTag(lgTmpTag).Class Then ' avoid id/name tags, as they are personalized for each item
' check other attrib
If Not (Not aTag(lgTag).Attrib) And (Not aTmpTag(lgTmpTag).Attrib) Then
bNewTag = False
bMatchAttrib = False
If UBound(aTmpTag(lgTmpTag).Attrib) UBound(aTag(lgTag).Attrib) Then
bNewTag = True
Else
ReDim aBoolChild(LBound(aTag(lgTag).Attrib) To UBound(aTag(lgTag).Attrib))
For lgAttrib = LBound(aTag(lgTag).Attrib) To UBound(aTag(lgTag).Attrib)
If aTag(lgTag).Attrib(lgAttrib).Attrib = aTmpTag(lgTmpTag).Attrib(lgAttrib).Attrib Then
aBoolChild(lgAttrib) = 49 '1
Else
aBoolChild(lgAttrib) = 48 '0
End If
Next lgAttrib
End If

bMatchAttrib = Not (StrConv(aBoolChild(), vbUnicode) Like "*[0]*")
If bMatchAttrib Then
Exit For
End If
Else
bMatchAttrib = True
Exit For
End If
End If
End If
Next lgTag
'Stop
If lgTag ")
lgPos = VBA.InStr(lgPos, VBA.LCase$(strLine), "¨") ' have attributes

If (lgPos > 0) And (lgPos < lgTagEnd) Then
Do
strAttrib = fAttribGet(strLine, lgPos)
strValue = fValueGet(strLine, lgPos)

strValue = VBA.Replace(strValue, "\¶", "\""") ' restore " chars in string
strValue = VBA.Replace(strValue, "\§", "\'") ' restore ' chars in string
strValue = VBA.Replace(strValue, "\\•", "\<") ' restore \< chars in string
strValue = VBA.Replace(strValue, "\•", "<") ' restore ") ' restore \> chars in string
strValue = VBA.Replace(strValue, "\¤", ">") ' restore > chars in string
strValue = VBA.Replace(strValue, "¨", "=") ' restore > chars in string
strValue = VBA.Replace(strValue, "\¡", "=") ' restore > chars in string

If strAttrib = "class" Then
.Class = strValue
ElseIf strAttrib = "name" Then
.Name = strValue
ElseIf strAttrib = "id" Then
.ID = VBA.Mid$(strLine, lgPos + VBA.Len("id¨"))
Else
' does attrib already exists?... not in the same Tag
lgAttrib = lgAttrib + 1
ReDim Preserve .Attrib(0 To lgAttrib)
.Attrib(lgAttrib).Attrib = strAttrib
.Attrib(lgAttrib).Value = strValue
End If
lgPos = VBA.InStr(lgPos + 1, VBA.LCase$(strLine), "¨")
If lgPos = 0 Then Exit Do
Loop While lgPos > 0
End If

' Get text inside HTML Tag
.InnerText = fTag_TextInside(strLine)

'If bChilds Then
' ' Get childs...
'End If
End With

End Function

Private Function fTagGetChild(ByVal lgLineStart As Long, _
ByVal lgLineEnd As Long, _
ByRef aTag() As tTag) As Long()
Dim aChild() As Long
Dim lgChild As Long
Dim lgLine As Long
Dim lgTmpTag As Long
Dim lgTag As Long

lgChild = -1
If lgLineStart = lgLineEnd Then 'autocontained
If Not (Not aTag) Then
For lgTag = LBound(aTag) To UBound(aTag)
'If aa a then bNewTag = True: Exit For
'End if
Next lgTag
Else
'ReDim Preserve aTag(0)
aTag(0) = aTmpTag(lgLine)
End If
Else
For lgLine = lgLineStart To lgLineEnd
If Not (PtrTag(lgLine).Tag Like "/*") Then
If PtrTag(lgLine).Tag > PtrTag(lgLineStart).Tag Then
'If Child does not exist then
lgChild = lgChild + 1
'ReDim Preserve xxx(xxx).Child(0 To lgChild)
'End if
Else
End If
End If
Next lgLine
End If

'fTagGetChild = lgTmpTag
Erase aChild()
End Function

Private Function fTag_TextInside(ByVal strLine As String) As String
'Optional byVal lgLineStart as long
'Optional byVal lgLineEnd as long
' Get text inside HTML Tag
Dim lgPos As Long
Dim strText As String
Dim lgLineRange As Long

lgPos = 1
lgPos = VBA.InStr(lgPos, VBA.LCase$(strLine), ">")
If lgPos > 0 Then
strText = VBA.Trim$(VBA.Mid$(strLine, lgPos + 1))
End If

'For lgLineRange = (lgLineStart + 1) To (lgLineEnd - 1)
' strText = strText & "<" & aCode(lgLineRange)
'Next lgLineRange
'If lgLine lgLineRange Then
' strLine = aCode(lgLineRange)
' strText = aStyle(lgStyle) & "<" & VBA.Mid$(1, strLine, VBA.InStr(1, strLine, "")
If lgPos_Space = 0 Then lgPos_Space = lgLen
If lgPos_GT = 0 Then lgPos_GT = lgLen

lgPos = VBA.CLng(fMin(Array(lgPos_Space, lgPos_GT)))
lgShifter = VBA.IIf(bOpen, 1, 2)
If lgPos > 0 Then
strTag = VBA.LCase$(VBA.Mid$(strTag, lgShifter, lgPos - lgShifter))
Else
lgPos = VBA.InStr(1, strTag, ">")
strTag = VBA.LCase$(VBA.Mid$(strTag, lgShifter, lgPos - 1))
End If

fTag = strTag
End Function

Private Function fTagStructure(ByRef myTag As tTag, _
ByVal lgTmpTag As Long, _
Optional ByVal lgLineStart As Long, _
Optional ByVal lgLineEnd As Long) As Boolean
Stop
' Get Tag structure

'If myTag.Name = vbNullString Then myTag.Name = fNamify(myTag.Class)

Dim lgLine As Long
Dim strTag As String
Dim strTagLine As String
Dim strLine As String
Dim lgLevel As Long

strTag = VBA.LCase$(fTag(strLine, True))
For lgLine = (lgLineStart + 1) To lgLineEnd
'strLine = aCode(lgLine)
If VBA.Mid$(strLine, 1, 1) = "/" Then
strTagLine = VBA.LCase$(fTag(strLine, False))
Else
strTagLine = VBA.LCase$(fTag(strLine, True))
End If

If (strTagLine = strTag) Then
lgLevel = lgLevel + 1
ElseIf (strTagLine = "/" & strTag) Then
lgLevel = lgLevel - 1
Else

End If
Next lgLine

End Function

Public Function fNamify(ByVal strClass As String) As String
' Get alternative name from Class attribute
Dim strNameShort As String
Dim lgChr As Long
Dim strChr As String

For lgChr = 1 To VBA.Len(strClass)
strChr = VBA.UCase$(VBA.Mid$(strClass, lgChr, 1))
If strChr = "-" Then ' avoid hyphen, and go to camelCase
If VBA.Mid$(strClass, lgChr + 1, 1) Like "[a-z,A-Z,0-9]" Then
lgChr = lgChr + 1
strNameShort = strNameShort & VBA.UCase$(VBA.Mid$(strClass, lgChr, 1))
Else
strNameShort = strNameShort
End If
ElseIf strChr = " " Then
strNameShort = strNameShort & "_"
End If
Next lgChr

fNamify = strNameShort
End Function

Private Function fMin(ByVal aValue As Variant) As Variant
Dim oValue As Variant
Dim oMin As Variant

oMin = aValue(LBound(aValue))
For Each oValue In aValue
If oMin > oValue Then oMin = oValue
Next oValue
fMin = oMin
End Function

Private Function fMax(ByVal aValue As Variant) As Variant
Dim oValue As Variant
Dim oMax As Variant

oMax = aValue(LBound(aValue))
For Each oValue In aValue
If oMax < oValue Then oMax = oValue
Next oValue
fMax = oMax
End Function
To this point you could probably are thinking “you’re pulling my leg, aren’t you?”, why the hell you just not use the ieFrame HTML library?. Well, I could, and it probably will be faster to develop (hours instead of two days), but just fitted for the HTML case. Case I needed to deal with any no HTML code, I will have to come this way, and remember I’m trying to do an App, and parse code not in </> style; so, only for this, it was a must be done (a stone in the way, but one that have to be passed).
1) From Quora I found some options, more concrete that the ones that came out from the G search. Here I list some of them, ordered IMHO from the best promising to the WTF solutions not doing what they claim for:
  • https://www.spreadsheetconverter.com/ I think is the most complete solution, but the optimization of the app is not very high, so they run clumsily. No macros, but they get JavaScript for formulas.
  • http://www.xlapp.io/xlapp_io/  similar to the one before, but seems poor capabilities, no JS code, only formulas.
  • https://trunao.com/  Just convert your spreadsheet into an online database
  • https://algo.airdev.co/ converting a Google Spreadsheet to database app
  • https://www.zoho.com/creator/spreadsheet-to-database-application.html something similar but with Zoho spreadsheets
  • https://www.appsheet.com/  another spreadsheet-to-database solution, via Dropbox or similar service.
  • https://powerapps.microsoft.com/ Azure HTML solution. Microsoft… you must be kidding with this, aren’t you?. In the end is a composer, not a translator, and with poor capabilities.
  • https://www.spreadsheetweb.com/ HTML app, tied to their engine, not a translator, but a more like a composer.
  • https://www.tableau.com/ HTML and desktop, Excel alternative, but can’t work as an app creator.
  • https://coda.io/templates HTML app, looks like Tableau, not a translator, but a composer. Looks simpler than Tableau, and more limited too.
  • https://keikai.io/ Looks like another web Spreadsheet solution, not really a translator
  • https://www.dronahq.com/ a web composer with a container for apps created with the service.
  • https://www.openasapp.net/ don’t really know what the hell is this. It has it own store for apps, that are HTML embbeded apps.
  • https://clappia.com/guest/#/app/SH706669?How-do-I-convert-an-Excel-spreadsheet-into-an-app  Here you send the Excel file and they return the converted app. Also they have a composer, but I could not get it to run.
2) EMACS6 is still evolving and getting new cappabilities, and on the other side VBA looks like stalled.

Leave a Reply

Your email address will not be published. Required fields are marked *