diff --git a/FL.bas b/FL.bas index ddfd8c3..257e12f 100644 --- a/FL.bas +++ b/FL.bas @@ -1294,7 +1294,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 @@ -1659,7 +1659,7 @@ Sub pricegroup_upload() Dim sql As String Selection.CurrentRegion.Select - sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J") + sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J") sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "COMMIT;" If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "10.56.60.254", False, "ptrowbridge", "qqqx53!030", "Port=5432;Database=ubm") Then @@ -1671,7 +1671,7 @@ Sub pricegroup_upload() Call x.ADOp_CloseCon(0) - sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "A") + sql = x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, True, "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "A", "A", "J") sql = "BEGIN" & vbCrLf & "DELETE FROM rlarp.price_map;" & vbCrLf & "INSERT INTO rlarp.price_map" & vbCrLf & sql & ";" & vbCrLf & "END" If Not x.ADOp_Exec(0, sql, 1, True, ADOinterface.SqlServer, "usmidsql01", True) Then @@ -1684,7 +1684,7 @@ Sub pricegroup_upload() Set x = Nothing - Call pricegroup_upload_db2 + 'Call pricegroup_upload_db2 MsgBox ("Upload Complete") diff --git a/PriceLists.bas b/PriceLists.bas index adf705b..5ccb729 100644 --- a/PriceLists.bas +++ b/PriceLists.bas @@ -610,6 +610,21 @@ Sub build_price_level(plev As String) fcws.Cells(1, 4).value = "Distributor Price List - Effective " & Format(effdate, "MM/DD/YYYY") fcws.Name = "Full Code Listing" fcws.Cells(3, 1).Select + '------------formatting for print----------------------------------- + Application.PrintCommunication = False + fcws.PageSetup.PrintTitleRows = "$1:$3" + fcws.PageSetup.Orientation = xlLandscape + With ActiveSheet.PageSetup + .LeftMargin = Application.InchesToPoints(0.25) + .RightMargin = Application.InchesToPoints(0.25) + .TopMargin = Application.InchesToPoints(0.75) + .BottomMargin = Application.InchesToPoints(0.75) + .HeaderMargin = Application.InchesToPoints(0.3) + .FooterMargin = Application.InchesToPoints(0.3) + .FitToPagesWide = 1 + .FitToPagesTall = False + End With + Application.PrintCommunication = True End If 'Application.ScreenUpdating = True @@ -623,7 +638,7 @@ Sub build_price_level(plev As String) '---------------------get price list------------------------------------------------------------------------ If pricelevel.chbNURSERY Then - pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") If pln(0, 0) <> "Product" Then MsgBox (pln(0, 0)) Exit Sub @@ -637,7 +652,7 @@ Sub build_price_level(plev As String) End If If pricelevel.chbFIBER Then - plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") If plf(0, 0) <> "Product" Then MsgBox (plf(0, 0)) Exit Sub @@ -654,7 +669,7 @@ Sub build_price_level(plev As String) End If End If - pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", False, 2000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") + pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm") If pl(0, 0) <> "Product" Then MsgBox (pl(0, 0)) Exit Sub @@ -717,6 +732,10 @@ Sub build_price_level(plev As String) If Not (fcwb Is Nothing) Then If pricelevel.tbPATH.text <> "" Then fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx" + If pricelevel.chPDF Then + fname = Replace(fcwb.Name, "xlsx", "pdf") + fcwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False + End If If Not pricelevel.chbLEAVEOPEN Then fcwb.Close End If diff --git a/Windows_API.cls b/Windows_API.cls index 8103154..5d1ff59 100644 --- a/Windows_API.cls +++ b/Windows_API.cls @@ -1,3 +1,12 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Windows_API" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False Option Explicit Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long @@ -164,7 +173,7 @@ End Function Sub TrackKeyPressInit() Dim msgMessage As MSG - Dim bCancel As Boolean + Dim bCANCEL As Boolean Dim iKeyCode As Integer Dim lXLhwnd As Long @@ -191,12 +200,12 @@ Sub TrackKeyPressInit() If iKeyCode = vbKeyBack Then SendKeys "{BS}" If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}" 'assume the cancel argument is False. - bCancel = False + bCANCEL = False 'the VBA RaiseEvent statement does not seem to return ByRef arguments 'so we call a KeyPress routine rather than a propper event handler. - Sheet_KeyPress ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel + Sheet_KeyPress ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCANCEL 'if the key pressed is allowed post it to the application. - If bCancel = False Then + If bCANCEL = False Then PostMessage _ lXLhwnd, msgMessage.Message, msgMessage.wParam, 0 End If @@ -219,18 +228,20 @@ End Sub '\\This example illustrates how to catch worksheet '\\Key strokes in order to prevent entering numeric '\\characters in the Range "A1:D10" . -Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, ByVal Target As range, Cancel As Boolean) +Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, ByVal KeyCode As Integer, ByVal Target As Range, cancel As Boolean) Const MSG As String = "Numeric Characters are not allowed in" & vbNewLine & "the Range: """ Const TITLE As String = "Invalid Entry !" - If Not Intersect(Target, range("A1:D10")) Is Nothing Then + If Not Intersect(Target, Range("A1:D10")) Is Nothing Then If Chr(KeyAscii) Like "[0-9]" Then - MsgBox MSG & range("A1:D10").Address(False, False) _ + MsgBox MSG & Range("A1:D10").address(False, False) _ & """ .", vbCritical, TITLE - Cancel = True + cancel = True End If End If End Sub + + diff --git a/pricelevel.frm b/pricelevel.frm index 218a5cf..2f3a964 100644 --- a/pricelevel.frm +++ b/pricelevel.frm @@ -14,6 +14,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False + Option Explicit Public x As New TheBigOne @@ -61,6 +62,8 @@ Private Sub lbPriceLev_Click() End Sub + + Private Sub UserForm_Initialize() Me.cancel = True @@ -89,7 +92,7 @@ Sub repopulate() End If Next i - tbEddDate.text = "03/01/2023" + tbEddDate.text = Format(Date, "mm/dd/yyyy") End Sub diff --git a/pricelevel.frx b/pricelevel.frx index 5b9b4a7..b654c9c 100644 Binary files a/pricelevel.frx and b/pricelevel.frx differ diff --git a/pricelist.frm b/pricelist.frm index b910982..07819a9 100644 --- a/pricelist.frm +++ b/pricelist.frm @@ -14,6 +14,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False + Option Explicit Public proceed As Boolean diff --git a/pricelist.frx b/pricelist.frx index 401c1f3..a2b1477 100644 Binary files a/pricelist.frx and b/pricelist.frx differ