From b1a4d149d319499ad3897dcc82ae320369a981bf Mon Sep 17 00:00:00 2001 From: Paul Trowbridge Date: Thu, 12 May 2022 17:39:53 -0400 Subject: [PATCH] currency, save file, and eff date --- PriceLists.bas | 49 +++++++++++++++++++++++++++++++++++++++++-------- pricelevel.frm | 15 +++++++++++++++ pricelevel.frx | Bin 0 -> 3608 bytes 3 files changed, 56 insertions(+), 8 deletions(-) create mode 100644 pricelevel.frm create mode 100644 pricelevel.frx diff --git a/PriceLists.bas b/PriceLists.bas index 02be01c..2b9d296 100644 --- a/PriceLists.bas +++ b/PriceLists.bas @@ -497,17 +497,22 @@ Sub build_pretty() Dim pl() As String Dim nwb As Workbook Dim nws As Worksheet - Dim prettyfilepath As String + Dim filepath As String Dim c As Range Dim i As Long Dim j As Long Dim last As Long Dim lastcol As Long + Dim clist() As String + Dim curr As String + Dim plev As String + Dim effdate As Date '---------------------get price list------------------------------------------------------------------------ login.Show + plev = InputBox("Price Level") If Not login.proceed Then Exit Sub - pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('U.AAA.DI')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm") + 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)) Exit Sub @@ -518,7 +523,6 @@ Sub build_pretty() nwb.Activate Set nws = nwb.Sheets(1) nws.Activate - nws.Name = "USD" nws.Cells.NumberFormat = "@" 'format all cells to text so pasted text values are not cast to numeric Call x.SHTp_Dump(pl, nws.Name, 5, 1, False, True) Application.ScreenUpdating = False @@ -555,7 +559,6 @@ Sub build_pretty() nws.Cells.Font.Size = 10 Rows("6:6").Select ActiveWindow.FreezePanes = True - nws.Cells(2, 3).value = "Distributor Price List (USD) - Effective 6/1/2022" '---------------------logo---------------------------------------------------------------------------------- ActiveSheet.Cells(1, 1).Select @@ -623,15 +626,42 @@ Sub build_pretty() If j < 0 Then Call merge(nws, i + j, i) End If Next i - nws.Columns("R:T").Delete + pl = x.TBLp_Transpose(pl) + Call x.TBLp_Group(pl, True, x.ARRAYp_MakeInteger(20)) + If UBound(pl, 2) > 1 Then + '---somehow multiple currencies involved---- + MsgBox ("multiple currencies") + Exit Sub + Else + Select Case pl(20, 1) + Case "C" + curr = "CAD" + Case "U" + curr = "USD" + Case Else + 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.Cells(5, 1).Select Application.ScreenUpdating = True Call print_setup(nws, last) + '--------------------save file-------------------------------------------------------------------------------- - 'prettyfilepath = "C:\Users\PTrowbridge\Downloads\PriceListPackage\" & "U.AAA.DI" & "\" & "HC Companies Distributor Price List.xlsx" - 'Call nwb.SaveAs(prettyfilepath, "XLSX") + Dim fd As Object + Set fd = Application.FileDialog(msoFileDialogFolderPicker) + fd.Show + filepath = fd.SelectedItems(1) & "\" & plev + With CreateObject("Scripting.FileSystemObject") + If Not .FolderExists(filepath) Then .CreateFolder filepath + End With + nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx" + nwb.Activate End Sub @@ -796,10 +826,13 @@ Sub print_setup(sheet As Worksheet, last_row As Long) .FooterMargin = Application.InchesToPoints(0.25) End With + sheet.DisplayPageBreaks = False + End Sub Sub call_print() - Call print_setup(ActiveSheet, 960) + Call print_setup(ActiveSheet, 1120) End Sub + diff --git a/pricelevel.frm b/pricelevel.frm new file mode 100644 index 0000000..136ff40 --- /dev/null +++ b/pricelevel.frm @@ -0,0 +1,15 @@ +VERSION 5.00 +Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelevel + Caption = "Build Customer Price List" + ClientHeight = 3960 + ClientLeft = 120 + ClientTop = 465 + ClientWidth = 4335 + OleObjectBlob = "pricelevel.frx":0000 + StartUpPosition = 1 'CenterOwner +End +Attribute VB_Name = "pricelevel" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False diff --git a/pricelevel.frx b/pricelevel.frx new file mode 100644 index 0000000000000000000000000000000000000000..ea73f7d258b615f2e9922f296e2706e9963fa0a9 GIT binary patch literal 3608 zcmeHJOK1~O6g`uqt=0I6v^83lLAod+#a0DHk!nq;wvti=UAW0-LQ|SX(^x1Xou#ha ziiqGs1a+eew<3s3b*Br_D!36Bf}fQ(p7SPCgHRdbDv%fM+&Aytckg-kHyJy+3Rs8b z@h%2DA-#MNTfFsP%lqYx>f|uOSgN$6wPwTOTx7-uAjFB@mnxNtw+L|B91Y}wU&N~T zi6RVQOEsPibcH6=|M0*Biu{#fBY_$666XC<4#c~dF}`{AgD?4=&)#%BkKMe6yEuI! zS*v96#{AWh+-ob$#X%(-N6uq)KO^iyzJ2kaimq21SuyB=7365&k}BOPsC~<=hLR zME@6X4oRdjwStwEmp9gN|MgTiQ&rhcuDA)mU;pa)Z6tm%OmAOJzJ?SfttII*qJF_o zfZ@7#b2O$05b4246j9|tWDrnp;1ck58*sc^FaA(AoKeb4GhZshJER20JHk^$u47+iOm5LOHEa0y~IS zh(SExDIi2jiUHCgl7&u;rP9uHzb9*MMp@;QvO*V?&Jd(Ck*a!E<4WrqS>jm65bj7-|ZongQCQ+ltc^}#lH z`Rb}Rgtrwj$|gr8v%pI5ZFAohl!GMcY%_9RjP7?-WkXR~0=_O-sK}{-hQ$sXCR}x& zzrVfGb~2wS6=#dNvOQcZ6=v;$zTIX9-5^m&JK3z0wUg;7R)uNqMyyZIzJ7c=@bG*f K7)_xD^}uf%BupLv literal 0 HcmV?d00001