update issues upload to merge and to target db2

FL.bas

@@ -541,7 +541,7 @@ Sub sql_from_range_db2_noqh()
     Dim wapi As New Windows_API
     Dim r() As String
     Selection.CurrentRegion.Select
-    Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, False))
+    Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, Db2, False, True))
 
 End Sub
 
@@ -561,13 +561,13 @@ Sub sql_from_range_pg_noqh()
     Dim wapi As New Windows_API
     Dim r() As String
     Selection.CurrentRegion.Select
-    Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False))
+    Call wapi.ClipBoard_SetData(x.SQLp_build_sql_values(x.ARRAYp_get_range_string(Selection), True, True, PostgreSQL, False, False))
 
 End Sub
 
 Sub auto_fit_range()
     
-    Selection.CurrentRegion.Columns.AutoFit
+    Selection.CurrentRegion.Columns.autofit
 
 End Sub
 
@@ -824,7 +824,7 @@ Sub extract_price_matrix()
     Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
     new_sh.Select
     ActiveSheet.Cells(1, 1).CurrentRegion.Select
-    Selection.Columns.AutoFit
+    Selection.Columns.autofit
     
     Rows("1:1").Select
     With ActiveWindow
@@ -1045,7 +1045,7 @@ Sub extract_price_matrix_suff()
     Call x.SHTp_Dump(cms_pl, new_sh.Name, 1, 1, True, True)
     new_sh.Select
     ActiveSheet.Cells(1, 1).CurrentRegion.Select
-    Selection.Columns.AutoFit
+    Selection.Columns.autofit
     
     Rows("1:1").Select
     With ActiveWindow
@@ -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
     
@@ -1412,12 +1412,12 @@ Sub price_issues()
     If ActiveSheet.Name <> "Issues" Then Exit Sub
     
     ilist = x.SHTp_Get(ActiveSheet.Name, 1, 1, True)
-    sql = "BEGIN;" & vbCrLf & "DELETE FROM rlarp.issues;" & vbCrLf & "INSERT INTO rlarp.issues" & vbCrLf
+    sql = "MERGE INTO RLARP.ISSUES i USING (" & vbCrLf
-    sql = sql & x.SQLp_build_sql_values(ilist, True, True, PostgreSQL, False, "S", "S", "S", "S") & ";"
+    sql = sql & x.SQLp_build_sql_values(ilist, True, True, Db2, False, True, "N", "N", "S", "D")
-    sql = sql & vbCrLf & "END;"
+    sql = sql & vbCrLf & ") x ON" & vbCrLf & "  x.ordern = i.ordern" & vbCrLf & "   AND x.linen = i.linen" & vbCrLf & "WHEN MATCHED THEN UPDATE SET" & vbCrLf & "   i.issue = x.issue" & vbCrLf & " ,i.odate = x.odate" & vbCrLf & "WHEN NOT MATCHED THEN INSERT VALUES (" & vbCrLf & " x.ordern , x.linen, x.issue, x.odate" & vbCrLf & ")"
     
     
-    If Not x.ADOp_Exec(0, sql, 1, True, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then
+    If Not x.ADOp_Exec(0, sql, 1, True, ISeries, "s7830956", False, "ptrowbridg", "qqqx53@048") Then
         MsgBox (x.ADOo_errstring)
     End If
     
@@ -1659,3 +1659,5 @@ Sub clear_page_breaks()
     Next b
     
 End Sub
+
+

PriceLists.bas

@@ -490,6 +490,8 @@ Sub build_customer_files()
     Dim plev As String
     Dim effdate As Date
     Dim segment_regex As String
+    Dim curr As String
+    Dim fname As String
     
     '----------------------pick price level---------------------------------------------------------------------
     login.Caption = "PostgreSQL Login"
@@ -595,7 +597,7 @@ Sub build_customer_files()
             segment_regex = "^F|^G|^P"
             Set nnws = nwb.Sheets.Add(, nws)
             nnws.Name = "Price List - Nursery"
-            Call paste_pretty(pln, nnws, effdate)
+            Call paste_pretty(pln, nnws, effdate, curr)
         End If
     End If
     
@@ -613,7 +615,7 @@ Sub build_customer_files()
             End If
             Set nfws = nwb.Sheets.Add(, nws)
             nfws.Name = "Price List - Fiber"
-            Call paste_pretty(plf, nfws, effdate)
+            Call paste_pretty(plf, nfws, effdate, curr)
         End If
     End If
     
@@ -624,7 +626,7 @@ Sub build_customer_files()
     End If
     If UBound(pl, 2) > 21 Then
         nws.Name = "Price list"
-        Call paste_pretty(pl, nws, effdate)
+        Call paste_pretty(pl, nws, effdate, curr)
     Else
         nws.Delete
     End If
@@ -642,11 +644,13 @@ Sub build_customer_files()
     Application.DisplayAlerts = True
     nwb.Activate
     
+    fname = "HC Companies Distributor Price List " & curr & ".xlsx"
+    
     Dim wb As Workbook
     For Each wb In Workbooks
-        If wb.Name = "HC Companies Distributor Price List.xlsx" Then
+        If wb.Name = fname Then
             If MsgBox("already have a price list open, close it?", vbOKCancel) Then
-                Workbooks("HC Companies Distributor Price List.xlsx").Close
+                Workbooks(fname).Close
                 Exit For
             Else
                 Exit Sub
@@ -654,8 +658,11 @@ Sub build_customer_files()
         End If
     Next wb
     
-    If pricelevel.tbPATH.text <> "" Then nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx"
+    If pricelevel.tbPATH.text <> "" Then nwb.SaveAs Filename:=filepath & "\" & fname
     
+    fname = Replace(fname, "xlsx", "pdf")
+    nwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
+
     For Each wb In Workbooks
         If wb.Name = "HC FullCode List.xlsx" Then
             If MsgBox("already have a full code list open, close it?", vbOKCancel) Then
@@ -674,14 +681,13 @@ Sub build_customer_files()
     
 End Sub
 
-Sub paste_pretty(ByRef pl() As String, ByRef nws As Worksheet, ByVal effdate As Date)
+Sub paste_pretty(ByRef pl() As String, ByRef nws As Worksheet, ByVal effdate As Date, ByRef curr As String)
 
     Dim c As Range
     Dim i As Long
     Dim last As Long
     Dim lastcol As Long
     Dim j As Long
-    Dim curr As String
 
     nws.Activate
     nws.Cells.NumberFormat = "@"
@@ -739,7 +745,7 @@ Sub paste_pretty(ByRef pl() As String, ByRef nws As Worksheet, ByVal effdate As
     nws.Columns(15).WrapText = True
     nws.Columns(11).ColumnWidth = 11.71
     nws.Columns(14).ColumnWidth = 11.71
-    nws.Columns(17).ColumnWidth = 11.71
+    nws.Columns(17).ColumnWidth = 13
     ActiveWindow.DisplayGridlines = False
     'nws.Cells.Font.Name = "Cascadia Code Light"
     nws.Cells.Font.Name = "Courier New"
@@ -1077,11 +1083,11 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
     '-------------------force a page break on color codes----------
     j = 1
     For i = 5 To last_row
-        If j = 60 Then
+        If j >= 810 Then
             sheet.HPageBreaks.Add before:=sheet.Rows(i + 1)
             j = 1
         End If
-        'every 73 rows is a page break for current font
+        'every 73 rows is a page break for current font, but if a row is taller this needs accounted for
         If sheet.Cells(i, 18) = "colors" And sheet.Cells(i - 1, 18) <> "colors" Then
             sheet.HPageBreaks.Add before:=sheet.Rows(i)
             j = 1
@@ -1090,7 +1096,7 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
             sheet.HPageBreaks.Add before:=sheet.Rows(i)
             j = 1
         End If
-        j = j + 1
+        j = j + sheet.Rows(i).RowHeight
     Next i
     
     sheet.DisplayPageBreaks = False