include Phils new modules
This commit is contained in:
parent
2c63d400f7
commit
304aeababa
43
VBA/JsonDebugPrint.bas
Normal file
43
VBA/JsonDebugPrint.bas
Normal file
@ -0,0 +1,43 @@
|
||||
Attribute VB_Name = "JsonDebugPrint"
|
||||
Option Explicit
|
||||
|
||||
|
||||
Public Sub TestPrintJSON()
|
||||
PrintJSON ParseJSON("[1,2,3]")
|
||||
PrintJSON ParseJSON("[{""a"":123,""b"":[56,7,78]}]")
|
||||
End Sub
|
||||
|
||||
' This is definitely NOT a pretty printer. It was written merely as a debugging
|
||||
' tool to make sense of the objects that come out of JsonConverter.ParseJSON.
|
||||
' It doesn't format in the best way possible, but it does provide a semi-readable
|
||||
' view of the data in the JSON object.
|
||||
' Phil Runninger 3/1/2023
|
||||
'
|
||||
Public Sub PrintJSON(obj As Variant, Optional level As Integer = 0)
|
||||
Dim itm As Variant
|
||||
Dim first As Boolean
|
||||
Select Case TypeName(obj)
|
||||
Case "Dictionary"
|
||||
Debug.Print String(level * 2, " "); "{"
|
||||
first = True
|
||||
For Each itm In obj
|
||||
If Not first Then Debug.Print String((level + 1) * 2, " "); ","
|
||||
first = False
|
||||
Debug.Print String((level + 1) * 2, " "); itm; ":";
|
||||
PrintJSON obj(itm), level + 1
|
||||
Next
|
||||
Debug.Print String(level * 2, " "); "}"
|
||||
Case "Collection"
|
||||
Debug.Print String(level * 2, " "); "["
|
||||
first = True
|
||||
For Each itm In obj
|
||||
If Not first Then Debug.Print String(level * 2, " "); ","
|
||||
first = False
|
||||
PrintJSON itm, level + 1
|
||||
Next
|
||||
Debug.Print String(level * 2, " "); "]"
|
||||
Case Else
|
||||
Debug.Print String(level * 2, " "); obj;
|
||||
End Select
|
||||
End Sub
|
||||
|
||||
618
VBA/Utils.bas
Normal file
618
VBA/Utils.bas
Normal file
@ -0,0 +1,618 @@
|
||||
Attribute VB_Name = "Utils"
|
||||
Option Explicit
|
||||
|
||||
Public ADOo_errstring As String
|
||||
|
||||
Public Function TBLp_Aggregate(ByRef tbl() As String, ByRef needsort As Boolean, ByRef headers As Boolean, ByRef del_unused As Boolean, ParamArray groupnum_type_sumnum()) As Boolean
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim nt() As String
|
||||
Dim keep() As Integer
|
||||
|
||||
If needsort Then
|
||||
If Not TBLp_BubbleSortAsc(tbl, PAp_2DGetIntegerArray(0, groupnum_type_sumnum), PAp_2DGetStringArray(1, groupnum_type_sumnum), headers) Then
|
||||
TBLp_Aggregate = False
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
|
||||
If Not TBLp_Roll(tbl, PAp_2DGetIntegerArray(0, groupnum_type_sumnum), PAp_2DGetIntegerArray(2, groupnum_type_sumnum), headers) Then
|
||||
TBLp_Aggregate = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
If del_unused Then
|
||||
keep = PAp_2DGetMultIntegerArray(ARRAYp_MakeInteger(0, 2), groupnum_type_sumnum)
|
||||
ReDim nt(UBound(keep()), UBound(tbl, 2))
|
||||
For i = 0 To UBound(keep())
|
||||
For j = 0 To UBound(tbl, 2)
|
||||
nt(i, j) = tbl(keep(i), j)
|
||||
Next j
|
||||
Next i
|
||||
tbl = nt
|
||||
End If
|
||||
|
||||
TBLp_Aggregate = True
|
||||
|
||||
End Function
|
||||
|
||||
Function TBLp_BubbleSortAsc(ByRef tbl() As String, ByRef sortflds() As Integer, ByRef typeflds() As String, ByRef headers As Boolean) As Boolean
|
||||
|
||||
On Error GoTo errh
|
||||
'get fort field numbers
|
||||
'loop through each row and generate the row key
|
||||
'eveluate the row key against other row keys
|
||||
'perform swaps
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim k As Long
|
||||
|
||||
k = 0
|
||||
If headers Then k = 1
|
||||
|
||||
For i = k To UBound(tbl, 2) - 1
|
||||
For j = i + 1 To UBound(tbl, 2)
|
||||
If ROWe_AscSwapFlag(tbl, i, j, sortflds, typeflds) Then
|
||||
Call ROWp_Swap(tbl, i, j)
|
||||
Else
|
||||
If ADOo_errstring <> "" Then
|
||||
TBLp_BubbleSortAsc = False
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
Next j
|
||||
Next i
|
||||
|
||||
errh:
|
||||
If Err.Number <> 0 Then
|
||||
MsgBox ("Error at TBLP_BubbleSortAsc." & vbCrLf & Err.Description)
|
||||
ADOo_errstring = Err.Description
|
||||
End If
|
||||
|
||||
TBLp_BubbleSortAsc = True
|
||||
|
||||
End Function
|
||||
|
||||
Public Function TBLp_Roll(ByRef tbl() As String, ByRef gflds() As Integer, ByRef sflds() As Integer, ByRef headers As Boolean) As Boolean
|
||||
|
||||
On Error GoTo errh
|
||||
Dim i As Long 'indexes primary row
|
||||
Dim j As Long 'indexes secondary chaecker row
|
||||
Dim k As Integer 'used to start at 0 or 1
|
||||
Dim m As Long 'used to aggregate on sequencing lines (i and j aggregate to m line) then shorten array to m length - 1
|
||||
|
||||
k = 0
|
||||
If headers Then k = 1
|
||||
m = k
|
||||
For i = k To UBound(tbl, 2)
|
||||
If i = UBound(tbl, 2) Then
|
||||
i = i
|
||||
End If
|
||||
j = i + 1
|
||||
Do
|
||||
If j > UBound(tbl, 2) Then Exit Do
|
||||
If ROWe_MatchesFlag(tbl, i, j, gflds) Then
|
||||
Call ROWp_Aggregate2Rows(tbl, i, j, sflds)
|
||||
Else
|
||||
Exit Do
|
||||
End If
|
||||
j = j + 1
|
||||
If j > UBound(tbl, 2) Then
|
||||
Exit Do
|
||||
End If
|
||||
Loop
|
||||
Call ROWp_Copy(tbl, i, m)
|
||||
m = m + 1
|
||||
i = j - 1
|
||||
Next i
|
||||
|
||||
ReDim Preserve tbl(UBound(tbl, 1), m - 1)
|
||||
|
||||
errh:
|
||||
If Err.Number <> 0 Then
|
||||
ADOo_errstring = Err.Description
|
||||
TBLp_Roll = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
TBLp_Roll = True
|
||||
|
||||
End Function
|
||||
|
||||
Sub ROWp_Swap(ByRef tbl() As String, ByRef p1 As Long, ByRef p2 As Long)
|
||||
|
||||
Dim temprow() As String
|
||||
ReDim temprow(UBound(tbl, 1))
|
||||
Dim i As Integer
|
||||
|
||||
For i = 0 To UBound(tbl, 1)
|
||||
temprow(i) = tbl(i, p2)
|
||||
Next i
|
||||
|
||||
For i = 0 To UBound(tbl, 1)
|
||||
tbl(i, p2) = tbl(i, p1)
|
||||
Next i
|
||||
|
||||
For i = 0 To UBound(tbl, 1)
|
||||
tbl(i, p1) = temprow(i)
|
||||
Next i
|
||||
|
||||
End Sub
|
||||
|
||||
Sub ROWp_Copy(ByRef tbl() As String, ByRef r_from As Long, ByRef r_to As Long)
|
||||
|
||||
Dim i As Integer
|
||||
|
||||
For i = 0 To UBound(tbl, 1)
|
||||
tbl(i, r_to) = tbl(i, r_from)
|
||||
Next i
|
||||
|
||||
End Sub
|
||||
|
||||
Sub ROWp_Aggregate2Rows(ByRef tbl() As String, ByRef p1 As Long, ByRef p2 As Long, ByRef sflds() As Integer)
|
||||
|
||||
Dim i As Integer
|
||||
On Error GoTo exitsub
|
||||
For i = 0 To UBound(sflds, 1)
|
||||
tbl(sflds(i), p1) = CDbl(tbl(sflds(i), p1)) + CDbl(tbl(sflds(i), p2))
|
||||
Next i
|
||||
|
||||
exitsub:
|
||||
|
||||
End Sub
|
||||
|
||||
Function ROWe_AscSwapFlag(ByRef tbl() As String, ByRef row1 As Long, ByRef row2 As Long, ByRef KeyFld() As Integer, ByRef TypeFld() As String) As Boolean
|
||||
'only returns true if greater than
|
||||
|
||||
On Error GoTo errh
|
||||
Dim i As Integer
|
||||
Dim compare As Integer
|
||||
|
||||
For i = 0 To UBound(KeyFld)
|
||||
Select Case TypeFld(i)
|
||||
Case "S"
|
||||
compare = MISCe_CompareString(CStr(tbl(KeyFld(i), row1)), CStr(tbl(KeyFld(i), row2)))
|
||||
Case "N"
|
||||
compare = MISCe_CompareDouble(CDbl(tbl(KeyFld(i), row1)), CDbl(tbl(KeyFld(i), row2)))
|
||||
Case "D"
|
||||
compare = MISCe_CompareDate(CDate(tbl(KeyFld(i), row1)), CDate(tbl(KeyFld(i), row2)))
|
||||
End Select
|
||||
Select Case compare
|
||||
Case -1
|
||||
ROWe_AscSwapFlag = True
|
||||
Exit Function
|
||||
Case 1
|
||||
ROWe_AscSwapFlag = False
|
||||
Exit Function
|
||||
End Select
|
||||
Next i
|
||||
|
||||
errh:
|
||||
If Err.Number <> 0 Then
|
||||
MsgBox ("Error at ROWe_AscSwapFlag." & vbCrLf & Err.Description)
|
||||
ADOo_errstring = Err.Description
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Function ROWe_MatchesFlag(ByRef tbl() As String, ByRef row1 As Long, ByRef row2 As Long, ByRef KeyFld() As Integer) As Boolean
|
||||
'only returns true if greater than
|
||||
|
||||
Dim i As Integer
|
||||
Dim k1 As String
|
||||
Dim k2 As String
|
||||
|
||||
For i = 0 To UBound(KeyFld())
|
||||
k1 = k1 & tbl(KeyFld(i), row1)
|
||||
Next i
|
||||
|
||||
For i = 0 To UBound(KeyFld())
|
||||
k2 = k2 & tbl(KeyFld(i), row2)
|
||||
Next i
|
||||
|
||||
|
||||
If k2 = k1 Then
|
||||
ROWe_MatchesFlag = True
|
||||
Else
|
||||
ROWe_MatchesFlag = False
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Sub SHTp_DumpVar(ByRef tbl() As Variant, ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef clear As Boolean, ByRef transpose As Boolean, ByRef zerobase As Boolean)
|
||||
|
||||
Dim sh As Worksheet
|
||||
Dim address As String
|
||||
Set sh = Sheets(sheet)
|
||||
|
||||
'If clear Then sh.Cells.clear
|
||||
'If transpose Then Call ARRAYp_Transpose(tbl)
|
||||
If zerobase Then
|
||||
address = sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1), col + UBound(tbl, 2)).address
|
||||
Else
|
||||
address = sh.Cells(row, col).address & ":" & sh.Cells(row + UBound(tbl, 1) - 1, col + UBound(tbl, 2) - 1).address
|
||||
End If
|
||||
sh.Range(address).FormulaR1C1 = tbl
|
||||
|
||||
On Error GoTo errhndl
|
||||
|
||||
|
||||
errhndl:
|
||||
If Err.Number <> 0 Then MsgBox ("Error in dumping to sheet" & vbCrLf & Err.Description)
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Function ARRAYp_TransposeVar(ByRef a() As Variant) As Variant()
|
||||
|
||||
Dim s() As Variant
|
||||
ReDim s(UBound(a, 2), UBound(a, 1))
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
|
||||
For i = 0 To UBound(s, 1)
|
||||
For j = 0 To UBound(s, 2)
|
||||
s(i, j) = a(j, i)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
ARRAYp_TransposeVar = s
|
||||
|
||||
End Function
|
||||
|
||||
Function ARRAYp_zerobased_addheader(ByRef z() As Variant, ParamArray cols()) As Variant()
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
|
||||
Dim r() As Variant
|
||||
ReDim r(UBound(z, 1), UBound(z, 2) + 1)
|
||||
|
||||
For i = 0 To UBound(r, 1)
|
||||
For j = 1 To UBound(r, 2)
|
||||
r(i, j) = z(i, j - 1)
|
||||
Next j
|
||||
r(i, 0) = cols(i)
|
||||
Next i
|
||||
|
||||
ARRAYp_zerobased_addheader = r
|
||||
|
||||
End Function
|
||||
|
||||
Public Function SHTp_Get(ByRef sheet As String, ByRef row As Long, ByRef col As Long, ByRef headers As Boolean) As String()
|
||||
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim table() As String
|
||||
Dim sh As Worksheet
|
||||
Set sh = Sheets(sheet)
|
||||
|
||||
On Error GoTo errhdnl
|
||||
|
||||
i = 1
|
||||
While sh.Cells(row, col + i - 1) <> ""
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
j = 1
|
||||
While sh.Cells(row + j - 1, col) <> ""
|
||||
j = j + 1
|
||||
Wend
|
||||
|
||||
ReDim table(i - 2, j - 2)
|
||||
i = 1
|
||||
While i <= UBound(table, 1) + 1
|
||||
j = 0
|
||||
While j <= UBound(table, 2)
|
||||
table(i - 1, j) = sh.Cells(row + j, col + i - 1)
|
||||
j = j + 1
|
||||
Wend
|
||||
i = i + 1
|
||||
Wend
|
||||
|
||||
errhdnl:
|
||||
If Err.Number <> 0 Then
|
||||
MsgBox (Err.Description)
|
||||
End If
|
||||
|
||||
SHTp_Get = table
|
||||
|
||||
End Function
|
||||
|
||||
Function PAp_2DGetStringArray(ByRef index As Integer, ParamArray pa()) As String()
|
||||
|
||||
Dim str() As String
|
||||
Dim i As Long
|
||||
ReDim str(UBound(pa(0)(index)))
|
||||
|
||||
For i = 0 To UBound(pa(0)(index))
|
||||
str(i) = pa(0)(index)(i)
|
||||
Next i
|
||||
PAp_2DGetStringArray = str
|
||||
|
||||
End Function
|
||||
|
||||
Function PAp_2DGetIntegerArray(ByRef index As Integer, ParamArray pa()) As Integer()
|
||||
|
||||
Dim str() As Integer
|
||||
Dim i As Long
|
||||
If UBound(pa(0)(index)) <> -1 Then
|
||||
ReDim str(UBound(pa(0)(index)))
|
||||
|
||||
For i = 0 To UBound(pa(0)(index))
|
||||
str(i) = pa(0)(index)(i)
|
||||
Next i
|
||||
End If
|
||||
PAp_2DGetIntegerArray = str
|
||||
|
||||
End Function
|
||||
|
||||
Function PAp_2DGetMultIntegerArray(ByRef ArraysGet() As Integer, ParamArray pa()) As Integer()
|
||||
|
||||
Dim str() As Integer
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim cnt As Long
|
||||
Dim index As Long
|
||||
|
||||
|
||||
'get length of selected arrays
|
||||
For i = 0 To UBound(ArraysGet, 1)
|
||||
cnt = cnt + UBound(pa(0)(ArraysGet(i)))
|
||||
Next i
|
||||
|
||||
ReDim str(cnt + 1)
|
||||
cnt = 0
|
||||
|
||||
For i = 0 To UBound(ArraysGet, 1)
|
||||
For j = 0 To UBound(pa(0)(ArraysGet(i)))
|
||||
str(cnt) = pa(0)(ArraysGet(i))(j)
|
||||
cnt = cnt + 1
|
||||
Next j
|
||||
Next i
|
||||
|
||||
PAp_2DGetMultIntegerArray = str
|
||||
|
||||
End Function
|
||||
|
||||
Public Function ARRAYp_MakeInteger(ParamArray items()) As Integer()
|
||||
|
||||
Dim x() As Integer
|
||||
Dim i As Integer
|
||||
ReDim x(UBound(items))
|
||||
|
||||
For i = 0 To UBound(items())
|
||||
x(i) = items(i)
|
||||
Next i
|
||||
|
||||
ARRAYp_MakeInteger = x
|
||||
|
||||
End Function
|
||||
|
||||
Public Function MISCe_CompareString(ByRef base As String, ByRef compare As String) As Integer
|
||||
|
||||
If compare < base Then
|
||||
MISCe_CompareString = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If compare = base Then
|
||||
MISCe_CompareString = 0
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If compare > base Then
|
||||
MISCe_CompareString = 1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Public Function MISCe_CompareDouble(ByRef base As Double, ByRef compare As Double) As Integer
|
||||
|
||||
If compare < base Then
|
||||
MISCe_CompareDouble = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If compare = base Then
|
||||
MISCe_CompareDouble = 0
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If compare > base Then
|
||||
MISCe_CompareDouble = 1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Public Function MISCe_CompareDate(ByRef base As Date, ByRef compare As Date) As Integer
|
||||
|
||||
|
||||
If compare < base Then
|
||||
MISCe_CompareDate = -1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If compare = base Then
|
||||
MISCe_CompareDate = 0
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
If compare > base Then
|
||||
MISCe_CompareDate = 1
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
Public Function json_from_table(ByRef tbl() As Variant, ByRef array_label As String, Optional strip_braces As Boolean) As String
|
||||
|
||||
|
||||
Dim ajson As String
|
||||
Dim json As String
|
||||
Dim r As Integer
|
||||
Dim c As Integer
|
||||
Dim needs_comma As Boolean
|
||||
Dim needs_braces As Integer
|
||||
|
||||
needs_comma = False
|
||||
needs_braces = 0
|
||||
ajson = ""
|
||||
|
||||
For r = 2 To UBound(tbl, 1)
|
||||
For c = 1 To UBound(tbl, 2)
|
||||
If tbl(r, c) <> "" Then
|
||||
needs_braces = needs_braces + 1
|
||||
If needs_comma Then json = json & ","
|
||||
needs_comma = True
|
||||
If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
|
||||
json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & tbl(r, c)
|
||||
Else
|
||||
'test if item is a json object
|
||||
If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
|
||||
json = json & """" & tbl(1, c) & """" & ":" & tbl(r, c)
|
||||
Else
|
||||
json = json & Chr(34) & tbl(1, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next c
|
||||
If needs_braces > 0 Then json = "{" & json & "}"
|
||||
needs_comma = False
|
||||
needs_braces = 0
|
||||
If r > 2 Then
|
||||
ajson = ajson & "," & json
|
||||
Else
|
||||
ajson = json
|
||||
End If
|
||||
json = ""
|
||||
Next r
|
||||
|
||||
'if theres more the one record, include brackets for array
|
||||
'if an array_label is given give the array a key and the array become the value
|
||||
'then if the array is labeled with a key it should have braces unless specified otherwise
|
||||
If r > 3 Then
|
||||
ajson = "[" & ajson & "]"
|
||||
If array_label <> "" Then
|
||||
ajson = """" & array_label & """:" & ajson
|
||||
If Not strip_braces Then
|
||||
ajson = "{" & ajson & "}"
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If strip_braces Then
|
||||
ajson = Mid(ajson, 2, Len(ajson) - 2)
|
||||
End If
|
||||
End If
|
||||
|
||||
json_from_table = ajson
|
||||
|
||||
End Function
|
||||
|
||||
Public Function json_from_table_zb(ByRef tbl() As Variant, ByRef array_label As String, ByVal force_array As Boolean, Optional strip_braces As Boolean) As String
|
||||
|
||||
Dim ajson As String
|
||||
Dim json As String
|
||||
Dim r As Integer
|
||||
Dim c As Integer
|
||||
Dim needs_comma As Boolean
|
||||
Dim needs_braces As Integer
|
||||
|
||||
needs_comma = False
|
||||
needs_braces = 0
|
||||
ajson = ""
|
||||
|
||||
For r = 1 To UBound(tbl, 1)
|
||||
For c = 0 To UBound(tbl, 2)
|
||||
If tbl(r, c) <> "" Then
|
||||
needs_braces = needs_braces + 1
|
||||
If needs_comma Then json = json & ","
|
||||
needs_comma = True
|
||||
If IsNumeric(tbl(r, c)) And Mid(tbl(r, c), 1, 1) <> 0 Then
|
||||
json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & tbl(r, c)
|
||||
Else
|
||||
'test if item is a json object
|
||||
If Mid(tbl(r, c), 1, 1) = "{" Or Mid(tbl(r, c), 1, 1) = "[" Then
|
||||
json = json & """" & tbl(0, c) & """" & ":" & tbl(r, c)
|
||||
Else
|
||||
json = json & Chr(34) & tbl(0, c) & Chr(34) & ":" & Chr(34) & tbl(r, c) & Chr(34)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next c
|
||||
If needs_braces > 0 Then json = "{" & json & "}"
|
||||
needs_comma = False
|
||||
needs_braces = 0
|
||||
If r > 1 Then
|
||||
ajson = ajson & "," & json
|
||||
Else
|
||||
ajson = json
|
||||
End If
|
||||
json = ""
|
||||
Next r
|
||||
|
||||
'if theres more the one record, include brackets for array
|
||||
'if an array_label is given give the array a key and the array become the value
|
||||
'then if the array is labeled with a key it should have braces unless specified otherwise
|
||||
If r > 2 Or force_array Then
|
||||
ajson = "[" & ajson & "]"
|
||||
If array_label <> "" Then
|
||||
ajson = """" & array_label & """:" & ajson
|
||||
If Not strip_braces Then
|
||||
ajson = "{" & ajson & "}"
|
||||
End If
|
||||
End If
|
||||
Else
|
||||
If strip_braces Then
|
||||
ajson = Mid(ajson, 2, Len(ajson) - 2)
|
||||
End If
|
||||
End If
|
||||
|
||||
json_from_table_zb = ajson
|
||||
|
||||
End Function
|
||||
|
||||
Public Function SHTp_get_block(point As Range) As Variant()
|
||||
|
||||
SHTp_get_block = point.CurrentRegion
|
||||
|
||||
End Function
|
||||
|
||||
Sub frmListBoxHeader(ByRef hdr As MSForms.listbox, ByRef det As MSForms.listbox, ParamArray cols())
|
||||
|
||||
Dim i As Long
|
||||
|
||||
hdr.ColumnCount = det.ColumnCount
|
||||
hdr.ColumnWidths = det.ColumnWidths
|
||||
|
||||
' add header elements
|
||||
hdr.clear
|
||||
hdr.AddItem
|
||||
For i = 0 To UBound(cols, 1)
|
||||
hdr.list(0, i) = cols(i)
|
||||
Next i
|
||||
|
||||
' make it pretty
|
||||
'body.ZOrder (1)
|
||||
'lbHEAD.ZOrder (0)
|
||||
hdr.SpecialEffect = fmSpecialEffectFlat
|
||||
'hdr.BackColor = RGB(200, 200, 200)
|
||||
hdr.Height = 10
|
||||
|
||||
' align header to body (should be done last!)
|
||||
hdr.width = det.width
|
||||
hdr.Left = det.Left
|
||||
hdr.Top = det.Top - (hdr.Height - 1)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user