pt/VBA
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Compare commits

base: pt:4b6d0c744dbb2ecde27d18c418e9c618a161679c
Branches Tags
pt:master
..
compare: pt:022240f8d36fa2802ff3a249d85c1f95bd84bd4e
Branches Tags
pt:master

No commits in common. "4b6d0c744dbb2ecde27d18c418e9c618a161679c" and "022240f8d36fa2802ff3a249d85c1f95bd84bd4e" have entirely different histories.
4b6d0c744d ... 022240f8d3

2 changed files with 14 additions and 72 deletions
Show Stats Expand all files Collapse all files

48
FL.bas
View File

@ -14,6 +14,8 @@ Public Enum ColorTier
O_rganic = 7
W_axtough = 8
End Enum
Sub Determine_Active_Range()
@ -57,7 +59,7 @@ Sub Cross_Join_Selection()
End If
i = i + 1
Next ar
dest = InputBox("Input row & column numbers like ""3,17""")
If dest = "" Then
@ -612,43 +614,13 @@ Sub markdown_whole_sheet()
End Sub
Sub sql_from_range_db2_qh()
Sub sql_from_range()
Dim x As New TheBigOne
Dim wapi As New Windows_API
Dim r() As String
Selection.CurrentRegion.Select
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, True))
End Sub
Sub sql_from_range_db2_noqh()
Dim x As New TheBigOne
Dim wapi As New Windows_API
Dim r() As String
Selection.CurrentRegion.Select
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, False))
End Sub
Sub sql_from_range_pg_qh()
Dim x As New TheBigOne
Dim wapi As New Windows_API
Dim r() As String
Selection.CurrentRegion.Select
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, True))
End Sub
Sub sql_from_range_pg_noqh()
Dim x As New TheBigOne
Dim wapi As New Windows_API
Dim r() As String
Selection.CurrentRegion.Select
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False))
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2))
End Sub
@ -850,7 +822,7 @@ Sub extract_price_matrix()
'-------------------------prepare sql to upload---------------------------------------------------------------
sql = x.SQLp_build_sql_values(unp, False, True, Db2, False)
sql = x.SQLp_build_sql_values(unp, False, True, Db2)
sql = "DECLARE GLOBAL TEMPORARY TABLE session.plbuild AS (" & sql & ") WITH DATA"
Call wapi.ClipBoard_SetData(sql)
@ -946,23 +918,15 @@ Sub go_to_price_issue()
Dim trow As Long
Dim tcol As Long
Dim i As Long
Dim has_Pricesheet As Boolean
has_Pricesheet = False
For Each ws In Application.Worksheets
For Each cp In ws.CustomProperties
If cp.Name = "spec_name" And cp.value = "price_list" Then
Set price_sheet = ws
has_Pricesheet = True
End If
Next cp
Next ws
If Not has_Pricesheet Then
MsgBox ("no price sheet found")
Exit Sub
End If
Set orig = Application.Selection
Selection.CurrentRegion.Select

38
TheBigOne.cls
View File

@ -2274,7 +2274,7 @@ Function MISCe_col_to_letter(ByRef x As Long) As String
End Function
Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, headers As Boolean, syntax As SQLsyntax, ByRef quote_headers As Boolean) As String
Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, headers As Boolean, syntax As SQLsyntax) As String
Dim i As Long
@ -2284,17 +2284,6 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
Dim type_flag() As String
Dim col_name As String
Dim start_row As Long
Dim rx As Object
Dim strip_text As String
Dim strip_num As String
Dim strip_date As String
Set rx = CreateObject("vbscript.regexp")
rx.Global = True
strip_text = "[^a-zA-Z0-9 \-\_\,\#\""]"
strip_num = "[^0-9\.]"
strip_date = "[^0-9\\\-\:\.]"
ReDim type_flag(UBound(tbl, 1))
For j = 0 To UBound(tbl, 1)
@ -2317,22 +2306,16 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
End If
Next j
rx.Pattern = strip_text
If headers Then
start_row = 1
For i = 0 To UBound(tbl, 1)
If i > 0 Then col_name = col_name & ","
If quote_headers Then
col_name = col_name & """" & rx.Replace(tbl(i, 0), "") & """"
Else
col_name = col_name & rx.Replace(tbl(i, 0), "")
End If
col_name = col_name & tbl(i, 0)
Next i
Else
start_row = 0
End If
For i = start_row To UBound(tbl, 2)
rec = ""
If i <> start_row Then sql = sql & "," & vbCrLf
@ -2341,40 +2324,35 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
If j <> 0 Then rec = rec & ","
Select Case type_flag(j)
Case "N" '-------N = numeric but should probably be N for numeric----
rx.Pattern = strip_num
If tbl(j, i) = "" Then
rec = rec & "CAST(NULL AS NUMERIC)"
Else
rec = rec & rx.Replace(tbl(j, i), "")
rec = rec & Replace(Replace(tbl(j, i), "'", "''"), ",", "")
End If
Case "S" '-------S = string------------------------------------------
rx.Pattern = strip_text
If LTrim(RTrim(tbl(j, i))) = "" Then
rec = rec & "CAST(NULL AS VARCHAR(255))"
Else
If trim Then
rec = rec & "'" & LTrim(RTrim(rx.Replace(tbl(j, i), ""))) & "'"
rec = rec & "'" & LTrim(RTrim(Replace(tbl(j, i), "'", "''"))) & "'"
Else
rec = rec & "'" & rx.Replace(tbl(j, i), "") & "'"
rec = rec & "'" & Replace(tbl(j, i), "'", "''") & "'"
End If
End If
Case "D" '-------D = date---------------------------------------------
rx.Pattern = strip_date
If LTrim(RTrim(tbl(j, i))) = "" Then
rec = rec & "CAST(NULL AS DATE)"
Else
rec = rec & "CAST('" & rx.Replace(tbl(j, i), "") & "' AS DATE)"
rec = rec & "CAST('" & tbl(j, i) & "' AS DATE)"
End If
Case Else '-------Assume text------------------------------------------
rx.Pattern = strip_text
If LTrim(RTrim(tbl(j, i))) = "" Then
rec = rec & "CAST(NULL AS VARCHAR(255))"
Else
If trim Then
rec = rec & "'" & LTrim(RTrim(rx.Replace(tbl(j, i), ""))) & "'"
rec = rec & "'" & LTrim(RTrim(Replace(tbl(j, i), "'", "''"))) & "'"
Else
rec = rec & "'" & rx.Replace(tbl(j, i), "") & "'"
rec = rec & "'" & Replace(tbl(j, i), "'", "''") & "'"
End If
End If
End Select