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

clean up and move code to core list file

This commit is contained in:
Paul Trowbridge 2022-05-20 12:38:56 -04:00
parent a788a91424
commit 69af558e8b
7 changed files with 46 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
PriceLists.bas
View File

@ -34,6 +34,9 @@ Sub test_full20()
unp = unpivot_current_sheet(lists, pcol)
login.Caption = "Postgres Login"
login.tbU = "report"
login.tbP = "report"
login.Show
If Not login.proceed Then Exit Sub
@ -240,6 +243,11 @@ Sub price_load_plcore()
sql = sql & vbCrLf & "INSERT INTO rlarp.plcore"
sql = sql & vbCrLf & x.SQLp_build_sql_values(load, True, True, PostgreSQL, False, False, "S", "S", "S", "S", "S", "S", "S", "N", "N", "S", "N", "N") & ";"
login.Caption = "Postgres Login"
login.tbU = LCase(Mid(Application.UserLibraryPath, 10, InStr(10, Application.UserLibraryPath, "\") - 10))
login.Show
If Not login.proceed Then Exit Sub
If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU, login.tbP, "Port=5030;Database=ubm") Then
MsgBox (x.ADOo_errstring)
Exit Sub
@ -318,33 +326,6 @@ PRICELIST_SHOW:
'target volume level
'ulsql = FL.x.SQLp_build_sql_values(pl, True, True, PostgreSQL, False)
'pl = x.TBLp_Transpose(pl)
'plv = x.TBLp_StringToVar(pl)
'ulsql = x.json_from_table(plv, "")
'ulsql = "DECLARE GLOBAL TEMPORARY TABLE session.plb AS (" & ulsql & ") WITH DATA"
' If login.tbP.Text = "" Then
' login.Show
' If Not login.proceed Then
' Exit Sub
' End If
' End If
'Call wapi.ClipBoard_SetData(ulsql)
'Exit Sub
'If Not FL.x.ADOp_Exec(0, ulsql, 1, True, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@041") Then
' MsgBox (FL.x.ADOo_errstring)
' Exit Sub
'End If
'pl = FL.x.ADOp_SelectS(0, "SELECT p.*, CASE WHEN COALESCE(c.jcpart,'') = '' THEN '1' ELSE '2' END flag FROM Session.plb P LEFT OUTER JOIN lgdat.iprcc c ON c.jcpart = P.Item AND c.JCPLCD = '" & pl_code & "' AND c.JCVOLL = p.vbqty * cast(p.num as float) / cast(p.den as float)", True, 10000, True)
'If Not FL.x.ADOp_Exec(0, "DROP TABLE SESSION.PLB", 1, True, ISeries, "S7830956", False, login.tbU.Text, login.tbP.Text) Then
' MsgBox (FL.x.ADOo_errstring)
' Exit Sub
'End If
'Call FL.x.ADOp_CloseCon(0)
ul(0, 0) = "HDR"
ul(1, 0) = pl_action
ul(2, 0) = pl_code
@ -758,7 +739,7 @@ Sub build_customer_files()
End If
Next wb
nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx"
If filepath <> "" Then nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx"
For Each wb In Workbooks
If wb.Name = "HC FullCode List.xlsx" Then
@ -771,7 +752,7 @@ Sub build_customer_files()
End If
Next wb
fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx"
If filepath <> "" Then fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx"
End Sub
@ -968,10 +949,3 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
Application.PrintCommunication = True
End Sub
Sub call_print()
Call print_setup(ActiveSheet, 1201)
End Sub

8
login.frm
View File

@ -13,13 +13,15 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public proceed As Boolean
Private Sub cbCANCEL_Click()
tbU.Text = ""
tbP.Text = ""
Private Sub cbCancel_Click()
tbU.text = ""
tbP.text = ""
proceed = False
Me.Hide
End Sub

BIN
login.frx
View File

Binary file not shown.

7
pricelevel.frm
View File

@ -13,6 +13,7 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public x As New TheBigOne
@ -33,7 +34,7 @@ Private Sub cbFolder_Click()
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Show
tbPath.text = fd.SelectedItems(1)
tbPATH.text = fd.SelectedItems(1)
End Sub
@ -66,12 +67,12 @@ End Sub
Sub repopulate()
Dim pl() As String
pl = x.SHTp_Get("Price Levels", 2, 1, True)
pl = x.SHTp_Get("Price Levels", 3, 1, True)
Me.lbPriceLev.list = x.TBLp_StringToVar(x.TBLp_Transpose(pl))
Dim i As Long
For i = 1 To lbPriceLev.ListCount
For i = 1 To lbPriceLev.ListCount - 1
If lbPriceLev.list(i, 0) = Selection Then
lbPriceLev.Selected(i) = True
Me.tbPriceLev = Selection

BIN
pricelevel.frx
View File

Binary file not shown.

57
pricelist.frm
View File

@ -13,12 +13,15 @@ Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public proceed As Boolean
Private pl() As String
Private plv() As Variant
Private plfv() As Variant
Public tbo As New TheBigOne
Private Sub bCANCEL_Click()
@ -60,7 +63,7 @@ Private Sub cbLIST_Change()
Dim plc() As String
plc = pl
Call FL.x.TBLp_FilterSingle(plc, 0, cbLIST.value, True)
Call tbo.TBLp_FilterSingle(plc, 0, cbLIST.value, True)
If UBound(plc, 2) = 0 Then Exit Sub
Me.tbD1 = plc(1, 1)
Me.tbD2 = plc(2, 1)
@ -85,7 +88,6 @@ End Sub
Private Sub UserForm_Initialize()
proceed = False
Dim x() As Variant
Dim i As Long
@ -105,29 +107,26 @@ Private Sub UserForm_Initialize()
cbHDR.list = x
cbDTL.list = dtl
' If login.tbP = "" Then
' login.Show
' If Not login.proceed Then Exit Sub
' If Not FL.x.ADOp_OpenCon(0, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@041") Then
' MsgBox (FL.x.ADOo_errstring)
' Exit Sub
' End If
' End If
login.Caption = "CMS Login"
login.tbU = Mid(Application.UserName, 1, 10)
login.tbP = ""
login.Show
If Not login.proceed Then Exit Sub
If Not FL.x.ADOp_OpenCon(1, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@048") Then
MsgBox (FL.x.ADOo_errstring)
If Not tbo.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU.text, login.tbP.text) Then
MsgBox (tbo.ADOo_errstring)
Exit Sub
End If
pl = FL.x.ADOp_SelectS(1, "SELECT JAPLCD, JAPLDS, JAPLD1, JAPLD2 FROM lgdat.iprca WHERE TRIM(COALESCE(JAPLCD,'')) <> '' ORDER BY JAPLCD ASC", True, 1000, False)
pl = tbo.ADOp_SelectS(1, "SELECT JAPLCD, JAPLDS, JAPLD1, JAPLD2 FROM lgdat.iprca WHERE TRIM(COALESCE(JAPLCD,'')) <> '' ORDER BY JAPLCD ASC", True, 1000, False)
'pl = FL.x.ADOp_SelectS(1, "SELECT plcode, d1,d2,d3 FROM RLARP.PLM p ORDER BY plcode", True, 1000, True)
Call FL.x.ADOp_CloseCon(1)
Call tbo.ADOp_CloseCon(1)
ReDim plv(1 To UBound(pl, 2))
For i = 1 To UBound(pl, 2)
plv(i) = pl(0, i)
Next i
plfv = FL.x.TBLp_StringToVar(FL.x.TBLp_Transpose(pl))
plfv = tbo.TBLp_StringToVar(tbo.TBLp_Transpose(pl))
@ -137,7 +136,7 @@ Private Sub UserForm_Initialize()
'lbHEAD.ColumnCount = lbHist.ColumnCount
'lbHEAD.ColumnWidths = lbHist.ColumnWidths
Call FL.x.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "descr1", "descr2", "descr3")
Call tbo.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "descr1", "descr2", "descr3")
@ -167,29 +166,27 @@ Sub load_lists()
cbHDR.list = x
cbDTL.list = dtl
' If login.tbP = "" Then
' login.Show
' If Not login.proceed Then Exit Sub
' If Not FL.x.ADOp_OpenCon(0, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@041") Then
' MsgBox (FL.x.ADOo_errstring)
' Exit Sub
' End If
' End If
login.Caption = "CMS Login"
login.tbU = Mid(UCase(Mid(Application.UserLibraryPath, 10, InStr(10, Application.UserLibraryPath, "\") - 10)), 1, 10)
login.tbP = ""
login.Show
If Not login.proceed Then Exit Sub
If Not FL.x.ADOp_OpenCon(1, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@048") Then
MsgBox (FL.x.ADOo_errstring)
If Not tbo.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU.text, login.tbP.text) Then
MsgBox (tbo.ADOo_errstring)
Exit Sub
End If
'pl = FL.x.ADOp_SelectS(1, "SELECT plcode, d1, d2, d3 FROM RLARP.PLM p ORDER BY plcode", True, 1000, True)
pl = FL.x.ADOp_SelectS(1, "SELECT JAPLCD, JAPLDS, JAPLD1, JAPLD2 FROM lgdat.iprca WHERE TRIM(COALESCE(JAPLCD,'')) <> '' ORDER BY JAPLCD ASC", True, 1000, False)
Call FL.x.ADOp_CloseCon(1)
pl = tbo.ADOp_SelectS(1, "SELECT JAPLCD, JAPLDS, JAPLD1, JAPLD2 FROM lgdat.iprca WHERE TRIM(COALESCE(JAPLCD,'')) <> '' ORDER BY JAPLCD ASC", True, 1000, False)
Call tbo.ADOp_CloseCon(1)
ReDim plv(1 To UBound(pl, 2))
For i = 1 To UBound(pl, 2)
plv(i) = pl(0, i)
Next i
plfv = FL.x.TBLp_StringToVar(FL.x.TBLp_Transpose(pl))
plfv = tbo.TBLp_StringToVar(tbo.TBLp_Transpose(pl))
cbLIST.list = plv
lbLIST.list = plfv
@ -197,6 +194,6 @@ Sub load_lists()
'lbHEAD.ColumnCount = lbHist.ColumnCount
'lbHEAD.ColumnWidths = lbHist.ColumnWidths
Call FL.x.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "d1", "d2", "d3")
Call tbo.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "d1", "d2", "d3")
End Sub

BIN
pricelist.frx
View File

Binary file not shown.