Import FL + TheBigOne from personal macrobook; secure new load_rep_or/load_dir_or creds
Export adds load_coa_map/load_customer_override (SQL Server USMIDSQL01), load_rep_or/load_dir_or (Postgres), markdown export helpers, ListAllSheets, SetRowHeights, and TheBigOne engine support. Claude change: load_rep_or/load_dir_or now use the login form (login.Show + login.tbU/tbP) instead of a hardcoded Postgres password; scrubbed that password from their commented lines too. NOTE: older price_* subs still contain hardcoded passwords already present in git history - rotate those passwords. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
parent
33b7f3da74
commit
8e383cbf80
372
FL.bas
372
FL.bas
@ -520,8 +520,14 @@ Sub markdown_whole_sheet()
|
||||
|
||||
Call wapi.ClipBoard_SetData(x.markdown_whole_sheet(ActiveSheet))
|
||||
|
||||
End Sub
|
||||
|
||||
Sub markdown_from_selection()
|
||||
|
||||
Dim x As New TheBigOne
|
||||
Dim wapi As New Windows_API
|
||||
|
||||
Call wapi.ClipBoard_SetData(x.markdown_from_selection())
|
||||
|
||||
End Sub
|
||||
|
||||
@ -567,7 +573,17 @@ Sub sql_from_range_pg_qh_all()
|
||||
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, True, "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A"))
|
||||
Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, False, "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A"))
|
||||
|
||||
End Sub
|
||||
|
||||
Sub sql_from_range_ms_qh_all()
|
||||
|
||||
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, SQLsyntax.SqlServer, True, False, "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A"))
|
||||
|
||||
End Sub
|
||||
|
||||
@ -583,7 +599,7 @@ End Sub
|
||||
|
||||
Sub auto_fit_range()
|
||||
|
||||
Selection.CurrentRegion.Columns.autofit
|
||||
Selection.CurrentRegion.Columns.AutoFit
|
||||
|
||||
End Sub
|
||||
|
||||
@ -840,7 +856,7 @@ Sub extract_price_matrix()
|
||||
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
|
||||
new_sh.Select
|
||||
ActiveSheet.Cells(1, 1).CurrentRegion.Select
|
||||
Selection.Columns.autofit
|
||||
Selection.Columns.AutoFit
|
||||
|
||||
Rows("1:1").Select
|
||||
With ActiveWindow
|
||||
@ -1061,7 +1077,7 @@ Sub extract_price_matrix_suff()
|
||||
Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
|
||||
new_sh.Select
|
||||
ActiveSheet.Cells(1, 1).CurrentRegion.Select
|
||||
Selection.Columns.autofit
|
||||
Selection.Columns.AutoFit
|
||||
|
||||
Rows("1:1").Select
|
||||
With ActiveWindow
|
||||
@ -1677,7 +1693,7 @@ Sub pricegroup_upload()
|
||||
|
||||
'---------------------------postgres------------------------------
|
||||
|
||||
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S")
|
||||
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "A", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S")
|
||||
sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";"
|
||||
sql = sql & vbCrLf & "REFRESH MATERIALIZED VIEW rlarp.molds;"
|
||||
sql = sql & vbCrLf & "COMMIT;"
|
||||
@ -1701,7 +1717,7 @@ Sub pricegroup_upload()
|
||||
|
||||
'---------------------------sql server------------------------------
|
||||
|
||||
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S")
|
||||
sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "A", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S")
|
||||
sql = "BEGIN" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "END"
|
||||
|
||||
If Not x.ADOp_Exec(1, sql, 1, True, ADOinterface.SqlServer, "usmidsql01", True) Then
|
||||
@ -1751,7 +1767,7 @@ Sub pricegroup_upload_db2()
|
||||
inc = 250
|
||||
Do While i <= UBound(ul, 2)
|
||||
'sql = x.ADOp_BuildInsertSQL(ul, "rlarp.price_map", True, i, WorksheetFunction.Min(i + inc, UBound(ul, 2)), Array("S", "S", "S", "S", "S", "S", "S", "N", "S", "S"))
|
||||
sql = x.SQLp_build_sql_values_ranged(ul, False, True, Db2, False, True, i, i + inc, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S")
|
||||
sql = x.SQLp_build_sql_values_ranged(ul, False, True, Db2, False, True, i, i + inc, "S", "S", "S", "A", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S")
|
||||
sql = "INSERT INTO rlarp.price_map " & vbCrLf & sql
|
||||
If Not x.ADOp_Exec(0, sql) Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
@ -2125,3 +2141,345 @@ Sub DataStyles()
|
||||
cs.Activate
|
||||
|
||||
End Sub
|
||||
|
||||
Sub sql_from_range_all_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, False))
|
||||
|
||||
End Sub
|
||||
|
||||
Sub ListAllSheets()
|
||||
Dim ws As Worksheet
|
||||
Dim newWorkbook As Workbook
|
||||
Dim newSheet As Worksheet
|
||||
Dim sourceWorkbook As Workbook
|
||||
Dim wb As Workbook
|
||||
Dim i As Integer
|
||||
Dim sheetCount As Integer
|
||||
Dim workbookList As String
|
||||
Dim selectedWorkbook As String
|
||||
Dim wbCount As Integer
|
||||
|
||||
' Check if there are other workbooks open
|
||||
wbCount = Workbooks.Count
|
||||
If wbCount = 1 Then
|
||||
MsgBox "No other workbooks are open. Please open the workbook you want to analyze.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Build a list of open workbooks
|
||||
workbookList = "Select a workbook to list sheets from:" & vbCrLf & vbCrLf
|
||||
i = 1
|
||||
For Each wb In Workbooks
|
||||
workbookList = workbookList & i & ". " & wb.Name & vbCrLf
|
||||
i = i + 1
|
||||
Next wb
|
||||
|
||||
' Ask user to select a workbook
|
||||
selectedWorkbook = InputBox(workbookList & vbCrLf & "Enter the number of the workbook:", "Select Workbook")
|
||||
|
||||
' Validate input
|
||||
If selectedWorkbook = "" Then
|
||||
Exit Sub ' User cancelled
|
||||
End If
|
||||
|
||||
If Not IsNumeric(selectedWorkbook) Then
|
||||
MsgBox "Invalid selection. Please enter a number.", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Val(selectedWorkbook) < 1 Or Val(selectedWorkbook) > wbCount Then
|
||||
MsgBox "Invalid selection. Please enter a number between 1 and " & wbCount, vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Set the source workbook based on selection
|
||||
Set sourceWorkbook = Workbooks(Val(selectedWorkbook))
|
||||
sheetCount = sourceWorkbook.Worksheets.Count
|
||||
|
||||
' Create a new workbook
|
||||
Set newWorkbook = Workbooks.Add
|
||||
Set newSheet = newWorkbook.Worksheets(1)
|
||||
newSheet.Name = "Sheet List"
|
||||
|
||||
' Add headers
|
||||
With newSheet
|
||||
.Cells(1, 1).value = "Sheet Number"
|
||||
.Cells(1, 2).value = "Sheet Name"
|
||||
.Cells(1, 3).value = "Visible Status"
|
||||
|
||||
' Format headers
|
||||
.Range("A1:C1").Font.Bold = True
|
||||
.Range("A1:C1").Interior.Color = RGB(200, 200, 200)
|
||||
End With
|
||||
|
||||
' List all sheets from the source workbook
|
||||
i = 2
|
||||
For Each ws In sourceWorkbook.Worksheets
|
||||
newSheet.Cells(i, 1).value = ws.index
|
||||
newSheet.Cells(i, 2).value = ws.Name
|
||||
|
||||
' Show visibility status
|
||||
Select Case ws.Visible
|
||||
Case xlSheetVisible
|
||||
newSheet.Cells(i, 3).value = "Visible"
|
||||
Case xlSheetHidden
|
||||
newSheet.Cells(i, 3).value = "Hidden"
|
||||
Case xlSheetVeryHidden
|
||||
newSheet.Cells(i, 3).value = "Very Hidden"
|
||||
End Select
|
||||
|
||||
i = i + 1
|
||||
Next ws
|
||||
|
||||
' Auto-fit columns
|
||||
newSheet.Columns("A:C").AutoFit
|
||||
|
||||
' Add a summary
|
||||
newSheet.Cells(i + 1, 1).value = "Total Sheets:"
|
||||
newSheet.Cells(i + 1, 2).value = sheetCount
|
||||
newSheet.Cells(i + 1, 1).Font.Bold = True
|
||||
|
||||
' Add source workbook info
|
||||
newSheet.Cells(i + 2, 1).value = "Source Workbook:"
|
||||
newSheet.Cells(i + 2, 2).value = sourceWorkbook.Name
|
||||
newSheet.Cells(i + 2, 1).Font.Bold = True
|
||||
|
||||
MsgBox "New workbook created with sheet list from '" & sourceWorkbook.Name & "'!" & vbCrLf & "Total sheets: " & sheetCount, vbInformation
|
||||
End Sub
|
||||
|
||||
Sub load_coa_map()
|
||||
|
||||
Dim sql As String
|
||||
Dim x As New TheBigOne
|
||||
Dim wapi As New Windows_API
|
||||
Dim r() As String
|
||||
ActiveSheet.Range("B8").Select
|
||||
Selection.CurrentRegion.Select
|
||||
sql = "DELETE FROM fanalysis.gs.coa_map; INSERT INTO fanalysis.gs.coa_map "
|
||||
sql = sql & x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, SQLsyntax.SqlServer, True, False, "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A")
|
||||
|
||||
If Not x.ADOp_Exec(0, sql, 10, True, ADOinterface.SqlServer, "USMIDSQL01", True) Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Else
|
||||
MsgBox ("Upload complete")
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Sub load_customer_override()
|
||||
|
||||
Dim sql As String
|
||||
Dim x As New TheBigOne
|
||||
Dim wapi As New Windows_API
|
||||
Dim r() As String
|
||||
ActiveSheet.Range("B8").Select
|
||||
Selection.CurrentRegion.Select
|
||||
sql = "BEGIN TRANSACTION; DELETE FROM rlarp.cust_override; INSERT INTO rlarp.cust_override "
|
||||
sql = sql & vbCrLf & x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, SQLsyntax.SqlServer, True, False, "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A")
|
||||
sql = sql & vbCrLf & "COMMIT TRANSACTION;"
|
||||
If Not x.ADOp_Exec(0, sql, 10, True, ADOinterface.SqlServer, "USMIDSQL01", True) Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Else
|
||||
MsgBox ("Upload complete")
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub load_rep_or()
|
||||
|
||||
Dim x As New TheBigOne
|
||||
Dim sql As String
|
||||
Dim ws() As String
|
||||
Dim i As Long
|
||||
Dim inc As Long
|
||||
|
||||
Selection.CurrentRegion.Select
|
||||
|
||||
ws = x.ARRAYp_get_range_string(Selection)
|
||||
|
||||
|
||||
login.Caption = "Postgres Creds"
|
||||
login.Show
|
||||
If Not login.proceed Then Exit Sub
|
||||
|
||||
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.0.10.40", False, login.tbU, login.tbP, "database=ubm") Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Not x.ADOp_Exec(0, "DELETE FROM rlarp.rep_or") Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
|
||||
'------------incremental upload----------------------
|
||||
i = 2
|
||||
inc = 250
|
||||
Do While i <= UBound(ws, 2)
|
||||
'sql = x.ADOp_BuildInsertSQL(ul, "rlarp.price_map", True, i, WorksheetFunction.Min(i + inc, UBound(ul, 2)), Array("S", "S", "S", "S", "S", "S", "S", "N", "S", "S"))
|
||||
sql = x.SQLp_build_sql_values_ranged(ws, False, True, PostgreSQL, False, True, i, i + inc, "A", "A")
|
||||
sql = "INSERT INTO rlarp.rep_or " & vbCrLf & sql
|
||||
If Not x.ADOp_Exec(0, sql) Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Call x.ADOp_CloseCon(0)
|
||||
Exit Sub
|
||||
End If
|
||||
i = i + inc + 1
|
||||
If i > UBound(ws, 2) Then Exit Do
|
||||
If i + inc > UBound(ws, 2) Then inc = UBound(ws, 2) - i
|
||||
Loop
|
||||
|
||||
If Not x.ADOp_Exec(0, "refresh materialized view rlarp.cust; refresh materialized view rlarp.customer_master;") Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
|
||||
' sql = "DROP TABLE IF EXISTS rlarp.fcws; CREATE TABLE rlarp.fcws AS ("
|
||||
' sql = sql & vbLf & x.SQLp_build_sql_values(ws, False, True, PostgreSQL, False, True, _
|
||||
' "S", "S", "S", "S", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "S", "S", "S", "S", "N")
|
||||
' 'sql = sql & vbLf & x.SQLp_build_sql_values(ws, False, True, PostgreSQL, False, True)
|
||||
' sql = sql & vbLf & ") WITH DATA;"
|
||||
|
||||
' If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "10.0.10.40", False, login.tbU, login.tbP, "database=ubm") Then
|
||||
' MsgBox (x.ADOo_errstring)
|
||||
' Exit Sub
|
||||
' End If
|
||||
|
||||
MsgBox ("Complete")
|
||||
|
||||
End Sub
|
||||
|
||||
Sub load_dir_or()
|
||||
|
||||
Dim x As New TheBigOne
|
||||
Dim sql As String
|
||||
Dim ws() As String
|
||||
Dim i As Long
|
||||
Dim inc As Long
|
||||
|
||||
ActiveSheet.Range("H8").Select
|
||||
Selection.CurrentRegion.Select
|
||||
|
||||
ws = x.ARRAYp_get_range_string(Selection)
|
||||
|
||||
|
||||
login.Caption = "Postgres Creds"
|
||||
login.Show
|
||||
If Not login.proceed Then Exit Sub
|
||||
|
||||
If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "10.0.10.40", False, login.tbU, login.tbP, "database=ubm") Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
If Not x.ADOp_Exec(0, "DELETE FROM rlarp.dir_or") Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
|
||||
'------------incremental upload----------------------
|
||||
i = 2
|
||||
inc = 250
|
||||
If i + inc > UBound(ws, 2) Then inc = UBound(ws, 2) - i
|
||||
Do While i <= UBound(ws, 2)
|
||||
'sql = x.ADOp_BuildInsertSQL(ul, "rlarp.price_map", True, i, WorksheetFunction.Min(i + inc, UBound(ul, 2)), Array("S", "S", "S", "S", "S", "S", "S", "N", "S", "S"))
|
||||
sql = x.SQLp_build_sql_values_ranged(ws, False, True, PostgreSQL, False, True, i, i + inc, "A", "A", "A")
|
||||
sql = "INSERT INTO rlarp.dir_or " & vbCrLf & sql
|
||||
If Not x.ADOp_Exec(0, sql) Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Call x.ADOp_CloseCon(0)
|
||||
Exit Sub
|
||||
End If
|
||||
i = i + inc + 1
|
||||
If i > UBound(ws, 2) Then Exit Do
|
||||
If i + inc > UBound(ws, 2) Then inc = UBound(ws, 2) - i
|
||||
Loop
|
||||
|
||||
If Not x.ADOp_Exec(0, "refresh materialized view rlarp.cust; refresh materialized view rlarp.customer_master;") Then
|
||||
MsgBox (x.ADOo_errstring)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
|
||||
|
||||
' sql = "DROP TABLE IF EXISTS rlarp.fcws; CREATE TABLE rlarp.fcws AS ("
|
||||
' sql = sql & vbLf & x.SQLp_build_sql_values(ws, False, True, PostgreSQL, False, True, _
|
||||
' "S", "S", "S", "S", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "N", "S", "S", "S", "S", "N")
|
||||
' 'sql = sql & vbLf & x.SQLp_build_sql_values(ws, False, True, PostgreSQL, False, True)
|
||||
' sql = sql & vbLf & ") WITH DATA;"
|
||||
|
||||
' If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "10.0.10.40", False, login.tbU, login.tbP, "database=ubm") Then
|
||||
' MsgBox (x.ADOo_errstring)
|
||||
' Exit Sub
|
||||
' End If
|
||||
|
||||
MsgBox ("Complete")
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
Sub SetRowHeights()
|
||||
|
||||
Dim ws As Worksheet
|
||||
Dim rng As Range
|
||||
Dim cell As Range
|
||||
Dim nonBlankHeight As Double
|
||||
Dim blankHeight As Double
|
||||
Dim lastRow As Long
|
||||
Dim usedCols As Long
|
||||
Dim isBlank As Boolean
|
||||
Dim i As Long
|
||||
Dim input1 As String
|
||||
Dim input2 As String
|
||||
|
||||
' Get heights from user with defaults
|
||||
input1 = InputBox("Height for non-blank rows:", "Non-Blank Row Height", "11.25")
|
||||
If input1 = "" Then Exit Sub ' User cancelled
|
||||
|
||||
input2 = InputBox("Height for blank rows:", "Blank Row Height", "3")
|
||||
If input2 = "" Then Exit Sub ' User cancelled
|
||||
|
||||
nonBlankHeight = CDbl(input1)
|
||||
blankHeight = CDbl(input2)
|
||||
|
||||
Set ws = ActiveSheet
|
||||
lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
|
||||
usedCols = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).column
|
||||
|
||||
' Turn off screen updating for speed
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
|
||||
For i = 1 To lastRow
|
||||
isBlank = (ws.Cells(i, 1).EntireRow.Cells(1, 1).value = "" And _
|
||||
Application.WorksheetFunction.CountA(ws.Range(ws.Cells(i, 1), ws.Cells(i, usedCols))) = 0)
|
||||
|
||||
If isBlank Then
|
||||
ws.Rows(i).RowHeight = blankHeight
|
||||
Else
|
||||
ws.Rows(i).RowHeight = nonBlankHeight
|
||||
End If
|
||||
Next i
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
|
||||
MsgBox "Done! " & lastRow & " rows processed.", vbInformation
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
134
TheBigOne.cls
134
TheBigOne.cls
@ -2599,6 +2599,119 @@ Public Function markdown_from_table(ByRef tbl() As Variant, Optional number_form
|
||||
|
||||
End Function
|
||||
|
||||
Function markdown_from_selection() As String
|
||||
|
||||
Dim MAX_DECIMALS As Integer
|
||||
MAX_DECIMALS = 5
|
||||
|
||||
Dim sel As Range
|
||||
Dim r As Long, c As Long
|
||||
Dim md As String
|
||||
Dim cellVal As String
|
||||
Dim colWidths() As Integer
|
||||
Dim numCols As Integer
|
||||
Dim numRows As Integer
|
||||
|
||||
If TypeName(Selection) <> "Range" Then
|
||||
MsgBox "Please select a range first.", vbExclamation
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Set sel = Selection
|
||||
numRows = sel.Rows.Count
|
||||
numCols = sel.Columns.Count
|
||||
ReDim colWidths(1 To numCols)
|
||||
|
||||
For c = 1 To numCols
|
||||
For r = 1 To numRows
|
||||
Dim l As Integer
|
||||
l = Len(CleanCellValue(sel.Cells(r, c), MAX_DECIMALS))
|
||||
If l > colWidths(c) Then colWidths(c) = l
|
||||
Next r
|
||||
If colWidths(c) < 3 Then colWidths(c) = 3
|
||||
Next c
|
||||
|
||||
' Header row
|
||||
md = "|"
|
||||
For c = 1 To numCols
|
||||
cellVal = CleanCellValue(sel.Cells(1, c), MAX_DECIMALS)
|
||||
md = md & " " & MD_PadRight(cellVal, colWidths(c)) & " |"
|
||||
Next c
|
||||
md = md & vbNewLine
|
||||
|
||||
' Separator row
|
||||
md = md & "|"
|
||||
For c = 1 To numCols
|
||||
md = md & " " & String(colWidths(c), "-") & " |"
|
||||
Next c
|
||||
md = md & vbNewLine
|
||||
|
||||
' Data rows
|
||||
For r = 2 To numRows
|
||||
md = md & "|"
|
||||
For c = 1 To numCols
|
||||
cellVal = CleanCellValue(sel.Cells(r, c), MAX_DECIMALS)
|
||||
md = md & " " & MD_PadRight(cellVal, colWidths(c)) & " |"
|
||||
Next c
|
||||
md = md & vbNewLine
|
||||
Next r
|
||||
|
||||
markdown_from_selection = md
|
||||
|
||||
' With CreateObject("Forms.TextBox.1")
|
||||
' .Multiline = True
|
||||
' .text = md
|
||||
' .SelStart = 0
|
||||
' .SelLength = Len(md)
|
||||
' .Copy
|
||||
' End With
|
||||
'
|
||||
' MsgBox "Markdown table copied to clipboard!" & vbNewLine & vbNewLine & md, vbInformation, "Markdown Table"
|
||||
End Function
|
||||
|
||||
Function CleanCellValue(cell As Range, MAX_DECIMALS As Integer) As String
|
||||
Dim v As String
|
||||
|
||||
If IsNumeric(cell.value) Then
|
||||
Dim fmt As String
|
||||
fmt = cell.NumberFormat
|
||||
|
||||
If InStr(fmt, "%") > 0 Then
|
||||
v = TruncateDecimals(cell.value * 100, MAX_DECIMALS) & "%"
|
||||
ElseIf InStr(fmt, "d") > 0 Or InStr(fmt, "m") > 0 Or InStr(fmt, "y") > 0 Then
|
||||
v = cell.text
|
||||
Else
|
||||
v = TruncateDecimals(cell.value, MAX_DECIMALS)
|
||||
End If
|
||||
Else
|
||||
v = trim(cell.text)
|
||||
End If
|
||||
|
||||
CleanCellValue = v
|
||||
End Function
|
||||
|
||||
Function TruncateDecimals(n As Double, MAX_DECIMALS As Integer) As String
|
||||
Dim rounded As Double
|
||||
Dim s As String
|
||||
|
||||
rounded = Round(n, MAX_DECIMALS)
|
||||
s = CStr(rounded)
|
||||
|
||||
If InStr(s, ".") > 0 Then
|
||||
Do While Right(s, 1) = "0"
|
||||
s = Left(s, Len(s) - 1)
|
||||
Loop
|
||||
If Right(s, 1) = "." Then s = Left(s, Len(s) - 1)
|
||||
End If
|
||||
|
||||
TruncateDecimals = s
|
||||
End Function
|
||||
|
||||
Function MD_PadRight(s As String, width As Integer) As String
|
||||
MD_PadRight = s & String(IIf(width - Len(s) > 0, width - Len(s), 0), " ")
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Public Function json_multirange(ByRef r As Range) As String
|
||||
|
||||
@ -2680,6 +2793,9 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
||||
Dim strip_num As String
|
||||
Dim strip_date As String
|
||||
Dim nullText As String
|
||||
Dim rc As Long
|
||||
Dim q_open As String
|
||||
Dim q_close As String
|
||||
|
||||
If syntax = PostgreSQL Then
|
||||
nullText = "text"
|
||||
@ -2724,13 +2840,21 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
||||
Next j
|
||||
End If
|
||||
|
||||
If syntax = SQLsyntax.SqlServer Then
|
||||
q_open = "["
|
||||
q_close = "]"
|
||||
Else
|
||||
q_open = """"
|
||||
q_close = """"
|
||||
End If
|
||||
|
||||
rx.Pattern = strip_text
|
||||
If headers Then
|
||||
start_row = LBound(tbl, 2) + 1
|
||||
For i = LBound(tbl, 1) To UBound(tbl, 1)
|
||||
If i > LBound(tbl, 1) Then col_name = col_name & ","
|
||||
If quote_headers Then
|
||||
col_name = col_name & """" & Replace(rx.Replace(tbl(i, LBound(tbl, 2)), ""), "'", "''") & """"
|
||||
col_name = col_name & q_open & Replace(rx.Replace(tbl(i, LBound(tbl, 2)), ""), "'", "''") & q_close
|
||||
Else
|
||||
col_name = col_name & Replace(rx.Replace(tbl(i, LBound(tbl, 2)), ""), "'", "''")
|
||||
End If
|
||||
@ -2822,7 +2946,13 @@ Public Function SQLp_build_sql_values(ByRef tbl() As String, trim As Boolean, he
|
||||
Next j
|
||||
rec = rec & ")"
|
||||
sql = sql & rec
|
||||
rc = rc + 1
|
||||
If rc = 200 Then
|
||||
'MsgBox (i)
|
||||
rc = 0
|
||||
End If
|
||||
Next i
|
||||
|
||||
'---------build select--------------------------
|
||||
Select Case syntax
|
||||
Case SQLsyntax.Db2
|
||||
@ -3050,7 +3180,7 @@ Public Function Misc_ConvBase10(ByVal d As Double, ByVal sNewBaseDigits As Strin
|
||||
Dim s As String, tmp As Double, i As Integer, lastI As Integer
|
||||
Dim BaseSize As Integer
|
||||
BaseSize = Len(sNewBaseDigits)
|
||||
Do While val(d) <> 0
|
||||
Do While Val(d) <> 0
|
||||
tmp = d
|
||||
i = 0
|
||||
Do While tmp >= BaseSize
|
||||
|
||||
Loading…
Reference in New Issue
Block a user