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

shift columns

Browse Source
This commit is contained in:
Paul Trowbridge 2024-09-24 11:39:22 -04:00
parent ec9d2f380a
commit 3a83430fc2
1 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
targets.bas
View File

@ -24,8 +24,8 @@ Sub get_options()
'----------------get the available options from all the parts setup in the item master----------------------------------------------
sql = "SELECT * FROM rlarp.get_options('" & mold & "');"
res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
ws.Range("N1:ZZ3500").ClearContents
res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
ws.Range("P1:ZZ3500").ClearContents
'----------------get the options already set if this item has been setup------------------------------------------------------------
fpath = Sheets("env").Range("B1").value & "\" & Sheets("combine").Range("A2").value & "\options.csv"
@ -34,13 +34,13 @@ Sub get_options()
Call x.ARRAYp_Transpose(onfile)
'merge all the options from the item master and the saved options
merge = x.TBLp_JoinTbls(onfile, res, True, True, 2, Array(0, 1, 3), Array(0, 1, 3), Array(2))
Call x.SHTp_Dump(merge, ws.Name, ws.Cells(ws.Rows.Count, 14).End(xlUp).row, 14, False, True, 15)
Call x.SHTp_Dump(merge, ws.Name, ws.Cells(ws.Rows.Count, 16).End(xlUp).row, 16, False, True, 17)
'loop through each result and highlight cells that only exist on the saved file and not the item master
'the last column indicated if the option is on the item master
i = 1
Do Until ws.Cells(i, 14) = ""
If ws.Cells(i, 18) = "" Then
With ws.Cells(i, 16).Interior
Do Until ws.Cells(i, 16) = ""
If ws.Cells(i, 20) = "" Then
With ws.Cells(i, 18).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
@ -51,15 +51,15 @@ Sub get_options()
i = i + 1
Loop
'get rid of the column used to flag for color
ws.Columns(18).ClearContents
ws.Columns(20).ClearContents
Else
Call x.SHTp_Dump(res, ws.Name, 1, 14, False, True, 15)
Call x.SHTp_Dump(res, ws.Name, 1, 16, False, True, 17)
End If
sql = "SELECT * FROM rlarp.get_option_costs('" & mold & "') ORDER BY branding, coltier, uomp;"
res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
ws.Range("C1:L350").ClearContents
Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 9, 10, 11)
res = x.ADOp_SelectS(0, sql, True, 10000, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
ws.Range("C1:N350").ClearContents
Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 9, 10, 11, 12, 13)
Call x.ADOp_CloseCon(0)
@ -90,7 +90,7 @@ Sub combine_options()
Set ws = ActiveSheet
mold = ws.Cells(2, 1)
stack = x.SHTp_GetString(ws.Range("N1"))
stack = x.SHTp_GetString(ws.Range("P1"))
stack = x.TBLp_Transpose(stack)
stackv = x.TBLp_StringToVar(stack)
json = x.json_from_table(stackv, "", False)
@ -99,8 +99,8 @@ Sub combine_options()
res = x.ADOp_SelectS(0, sql, True, 5000, True, PostgreSQLODBC, "usmidsap02", False, "report", "report", "Port=5432;Database=ubm")
Call x.ADOp_CloseCon(0)
ws.Range("S1:AC5000").ClearContents
Call x.SHTp_Dump(res, ws.Name, 1, 19, False, True)
ws.Range("U1:AC5000").ClearContents
Call x.SHTp_Dump(res, ws.Name, 1, 21, False, True)
End Sub
@ -127,8 +127,8 @@ Sub save_targets()
Set ws = ActiveSheet
opt = x.SHTp_Get(ws.Name, 1, 14, True)
tar = x.SHTp_Get(ws.Name, 1, 19, True)
opt = x.SHTp_Get(ws.Name, 1, 16, True)
tar = x.SHTp_Get(ws.Name, 1, 21, True)
path = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1) & "\options.csv"
If Not x.FILEp_CreateCSV(path, opt) Then
@ -148,7 +148,7 @@ Sub save_targets()
sqlt = sqlt & sql(0, i) & vbCrLf
Next i
targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 19, True), True, True, PostgreSQL, False, True, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 21, True), True, True, PostgreSQL, False, True, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
sqlt = Replace(sqlt, "replace_this", targt)
@ -164,7 +164,7 @@ Sub save_targets()
sqlt = sqlt & sql(0, i) & vbCrLf
Next i
targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 19, True), True, True, PostgreSQL, False, True, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 21, True), True, True, PostgreSQL, False, True, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
sqlt = Replace(sqlt, "replace_this", targt)
@ -182,7 +182,7 @@ Sub save_targets()
'Foldername = Sheets("env").Cells(1, 2) & "\" & ActiveSheet.Cells(2, 1)
'Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
ws.Cells(1, 14).CurrentRegion.Select
ws.Cells(1, 16).CurrentRegion.Select
tbl = Selection
Call wapi.ClipBoard_SetData(x.markdown_from_table(tbl))