convert fullcode to pdf

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")
 

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

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
 
+
+

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

pricelist.frm

@@ -14,6 +14,7 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 
+
 Option Explicit
 
 Public proceed As Boolean