currency, save file, and eff date

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"
+    Dim fd As Object
-    'Call nwb.SaveAs(prettyfilepath, "XLSX")
+    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
+

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