From aee26ac1a3887360078c1dd99c2e592015bf28e7 Mon Sep 17 00:00:00 2001 From: Paul Trowbridge Date: Tue, 17 May 2022 10:33:24 -0400 Subject: [PATCH] work on price lists --- PriceLists.bas | 68 ++++++++++++++++++++++++++++++++------------- TheBigOne.cls | 2 +- pricelevel.frm | 74 +++++++++++++++++++++++++++++++++++++++++++++++-- pricelevel.frx | Bin 3608 -> 3608 bytes 4 files changed, 121 insertions(+), 23 deletions(-) diff --git a/PriceLists.bas b/PriceLists.bas index 2b9d296..0ec4cf9 100644 --- a/PriceLists.bas +++ b/PriceLists.bas @@ -245,13 +245,10 @@ Sub price_load_plcore() Exit Sub End If - If Not x.ADOp_Exec(1, sql, 1, True, ADOinterface.SqlServer, "mid-sql02", True) Then - MsgBox (x.ADOo_errstring) - Exit Sub - End If - - Call x.ADOp_CloseCon(0) - Call x.ADOp_CloseCon(1) + 'If Not x.ADOp_Exec(1, sql, 1, True, ADOinterface.SqlServer, "mid-sql02", True) Then + ' MsgBox (x.ADOo_errstring) + ' Exit Sub + 'End If End Sub @@ -376,7 +373,7 @@ PRICELIST_SHOW: '--------Open file------------- - If Not x.FILEp_CreateCSV(pricelist.tbPATH.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then + If Not x.FILEp_CreateCSV(pricelist.tbPath.text & "\" & Replace(pl_code, ".", "_") & ".csv", ul) Then MsgBox ("error") End If @@ -508,10 +505,21 @@ Sub build_pretty() Dim plev As String Dim effdate As Date - '---------------------get price list------------------------------------------------------------------------ + '----------------------pick price level--------------------------------------------------------------------- login.Show - plev = InputBox("Price Level") If Not login.proceed Then Exit Sub + Call pricelevel.repopulate + pricelevel.Show + If pricelevel.cancel Then Exit Sub + plev = pricelevel.tbPriceLev.text + If Not IsDate(pricelevel.tbEddDate.text) Then + MsgBox ("cannot interperet date - " & pricelevel.tbEddDate.text) + Exit Sub + End If + effdate = CDate(pricelevel.tbEddDate.text) + filepath = pricelevel.tbPath & "\" & plev + + '---------------------get price list------------------------------------------------------------------------ pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm") If pl(0, 0) <> "Product" Then MsgBox (pl(0, 0)) @@ -642,10 +650,9 @@ Sub build_pretty() MsgBox ("unknown currency - " & pl(20, 1)) End Select End If - effdate = "06/01/2022" nws.Cells(2, 3).value = "Distributor Price List (" & curr & ") - Effective " & Format(effdate, "MM/DD/YYYY") nws.Name = curr - nws.Columns("R:U").Delete + nws.Columns("R:V").Delete nws.Cells(5, 1).Select Application.ScreenUpdating = True @@ -653,15 +660,29 @@ Sub build_pretty() '--------------------save file-------------------------------------------------------------------------------- - Dim fd As Object - Set fd = Application.FileDialog(msoFileDialogFolderPicker) - fd.Show - filepath = fd.SelectedItems(1) & "\" & plev + 'Dim fd As Object + 'Set fd = Application.FileDialog(msoFileDialogFolderPicker) + 'fd.Show + 'If fd.SelectedItems.Count = 0 Then Exit Sub With CreateObject("Scripting.FileSystemObject") If Not .FolderExists(filepath) Then .CreateFolder filepath End With - nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx" + Application.DisplayAlerts = True nwb.Activate + + Dim wb As Workbook + For Each wb In Workbooks + If wb.Name = "HC Companies Distributor Price List.xlsx" Then + If MsgBox("already have a price list open, close it?", vbOKCancel) Then + Workbooks("HC Companies Distributor Price List.xlsx").Close + Exit For + Else + Exit Sub + End If + End If + Next wb + + nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx" End Sub @@ -811,12 +832,12 @@ Sub print_setup(sheet As Worksheet, last_row As Long) Dim Sel As Range Set Sel = rrange(sheet, 6, last_row, 1, 17) + + Application.PrintCommunication = False With sheet.PageSetup .PrintArea = Sel.address .PrintTitleRows = "$1:$5" - .Orientation = xlLandscape - .FitToPagesWide = 1 '.FitToPagesTall = 0 .LeftMargin = Application.InchesToPoints(0.25) .RightMargin = Application.InchesToPoints(0.25) @@ -824,15 +845,22 @@ Sub print_setup(sheet As Worksheet, last_row As Long) .BottomMargin = Application.InchesToPoints(0.25) .HeaderMargin = Application.InchesToPoints(0.25) .FooterMargin = Application.InchesToPoints(0.25) + .Orientation = xlLandscape + .FitToPagesWide = 1 End With + sheet.PageSetup.FitToPagesWide = 1 + sheet.PageSetup.FitToPagesTall = 0 + sheet.DisplayPageBreaks = False + Application.PrintCommunication = True + End Sub Sub call_print() - Call print_setup(ActiveSheet, 1120) + Call print_setup(ActiveSheet, 1201) End Sub diff --git a/TheBigOne.cls b/TheBigOne.cls index 464595e..7080eaa 100644 --- a/TheBigOne.cls +++ b/TheBigOne.cls @@ -1546,7 +1546,7 @@ Public Function MISCp_msgbox_cancel(ByRef Message As String, Optional ByRef TITL MsgB.Caption = TITLE MsgB.tbMSG.ScrollBars = fmScrollBarsBoth MsgB.Show - MISC_msgbox_cancel = MsgB.Cancel + MISC_msgbox_cancel = MsgB.cancel Application.EnableCancelKey = xlInterrupt End Function diff --git a/pricelevel.frm b/pricelevel.frm index 136ff40..8fb4d08 100644 --- a/pricelevel.frm +++ b/pricelevel.frm @@ -1,10 +1,10 @@ VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelevel Caption = "Build Customer Price List" - ClientHeight = 3960 + ClientHeight = 7920 ClientLeft = 120 ClientTop = 465 - ClientWidth = 4335 + ClientWidth = 8775.001 OleObjectBlob = "pricelevel.frx":0000 StartUpPosition = 1 'CenterOwner End @@ -13,3 +13,73 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False +Option Explicit + +Public x As New TheBigOne +Public cancel As Boolean + + +Private Sub cbCancel_Click() + + cancel = True + Me.Hide + +End Sub + +Private Sub cbFolder_Click() + Dim fd As Object + + '--------Open file------------- + Set fd = Application.FileDialog(msoFileDialogFolderPicker) + fd.Show + + tbPath.text = fd.SelectedItems(1) +End Sub + + +Private Sub cbOK_Click() + cancel = False + Me.Hide +End Sub + +Private Sub lbPriceLev_Click() + + Dim i As Long + + For i = 1 To lbPriceLev.ListCount + If lbPriceLev.Selected(i) Then + tbPriceLev.text = lbPriceLev.list(i, 0) + Exit For + End If + Next i + + +End Sub + +Private Sub UserForm_Initialize() + + Me.cancel = True + + +End Sub + +Sub repopulate() + + Dim pl() As String + pl = x.SHTp_Get("Price Levels", 2, 1, True) + Me.lbPriceLev.list = x.TBLp_StringToVar(x.TBLp_Transpose(pl)) + + Dim i As Long + + For i = 1 To lbPriceLev.ListCount + If lbPriceLev.list(i, 0) = Selection Then + lbPriceLev.Selected(i) = True + Me.tbPriceLev = Selection + Exit For + End If + Next i + + tbEddDate.text = "06/01/2022" + + +End Sub diff --git a/pricelevel.frx b/pricelevel.frx index ea73f7d258b615f2e9922f296e2706e9963fa0a9..c885c326cfcf16670f65b415b0afa56667310f73 100644 GIT binary patch delta 656 zcmY*XO=uHA6#izj8+Ws*c0o5mt4*6)LMwt=t5T6r+afg5RD1B~?q;BYH7#Z7B}n$_ zr5fkbi%<|ecvCNeAYK*mT+mw)4|>##NZ0qWQFP$(e&&0B-^}*V_K;hfHGzZpdoGlL zOC!(RmOc=#fB*Qixhpbs8LO_|5nq&Jv<;2?U#e@gok6l%{Zv6Zr;cZjowUf>Pm;tY zohKO};SPsLIPS21aYlP3I?yY)mLJSBOs@h-0u;!`U10Mv@Nk-)^ki=A+1>jeoJV_j zip7`9-0*>zn-$2ec&lr7Jb*jL9KR=C17rA1cD5gy>QyNq^6Or-3bbhrF{y5u)9RgB z6Ho;!P|vM-QB`lOa=8kvgbL-*j`2+y${;E&G(%b9>~GYlt*L!$SiLpR7mK((B4Vze z(U>g2xCk6Rp<3p!PTqvt$+@ne%_4uk(U|ihNl_l)`f2q(cl3&eBdB@449}+FC#Seb z1wZ=p(+;335F^O^!JbR8G)LWbJ31T${?Z~>U1w}RonAL)T4qRSC>TB5Rj(Du@GEhW zVpFOZnB-_I+tc4A^!8JdPQ;=#hrG$z3#h6mFw^e;+qZ!DW+)QWMqEGZMn12E{ VKY$`azy2R~R98FpFmEK-?