work on price lists

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
+    'If Not x.ADOp_Exec(1, sql, 1, True, ADOinterface.SqlServer, "mid-sql02", True) Then
-        MsgBox (x.ADOo_errstring)
+    '    MsgBox (x.ADOo_errstring)
-        Exit Sub
+    '    Exit Sub
-    End If
+    'End If
-    
-    Call x.ADOp_CloseCon(0)
-    Call x.ADOp_CloseCon(1)
     
     
 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
+    'Dim fd As Object
-    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
+    'Set fd = Application.FileDialog(msoFileDialogFolderPicker)
-    fd.Show
+    'fd.Show
-    filepath = fd.SelectedItems(1) & "\" & plev
+    '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
 

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

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