formatting and add checkboxes to form

PriceLists.bas

@@ -354,7 +354,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
     
@@ -504,7 +504,7 @@ Sub build_customer_files()
         Exit Sub
     End If
     effdate = CDate(pricelevel.tbEddDate.text)
-    filepath = pricelevel.tbPath & "\" & plev
+    filepath = pricelevel.tbPATH & "\" & plev
     
     '---------------------get full code list--------------------------------------------------------------------
     fc = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_fullcode_cust('" & plev & "', '" & effdate & "'::date)", False, 20000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm")
@@ -588,13 +588,13 @@ Sub build_customer_files()
     Application.ScreenUpdating = False
     
     '---------------------whole sheet formatting----------------------------------------------------------------
-    nws.Columns(9).HorizontalAlignment = xlCenter
+    nws.Columns(9).HorizontalAlignment = xlRight
     nws.Columns(10).HorizontalAlignment = xlRight
     nws.Columns(11).HorizontalAlignment = xlRight
-    nws.Columns(12).HorizontalAlignment = xlCenter
+    nws.Columns(12).HorizontalAlignment = xlRight
     nws.Columns(13).HorizontalAlignment = xlRight
     nws.Columns(14).HorizontalAlignment = xlRight
-    nws.Columns(15).HorizontalAlignment = xlCenter
+    nws.Columns(15).HorizontalAlignment = xlRight
     nws.Columns(16).HorizontalAlignment = xlRight
     nws.Columns(17).HorizontalAlignment = xlRight
     nws.Columns(1).ColumnWidth = 12
@@ -604,10 +604,18 @@ Sub build_customer_files()
     nws.Columns(5).ColumnWidth = 4.86
     nws.Columns(6).ColumnWidth = 4.86
     nws.Columns(7).ColumnWidth = 4.86
+    If pricelevel.chbColors Then
+        nws.Columns(8).ColumnWidth = 17
+        nws.Columns(8).WrapText = True
+    Else
         nws.Columns(8).ColumnWidth = 11
-    nws.Columns(9).ColumnWidth = 17.71
+    End If
-    nws.Columns(12).ColumnWidth = 17.71
+    nws.Columns(9).ColumnWidth = 8.29
-    nws.Columns(15).ColumnWidth = 17.71
+    nws.Columns(9).WrapText = True
+    nws.Columns(12).ColumnWidth = 8.29
+    nws.Columns(12).WrapText = True
+    nws.Columns(15).ColumnWidth = 8.29
+    nws.Columns(15).WrapText = True
     nws.Columns(10).ColumnWidth = 10.57
     nws.Columns(13).ColumnWidth = 10.57
     nws.Columns(16).ColumnWidth = 10.57
@@ -636,19 +644,22 @@ Sub build_customer_files()
     Next c
     Application.DisplayAlerts = False
     With nws.Range("I4")
-        .value = "-----------Single Package--------"
+        .value = "------Single Package------"
         .HorizontalAlignment = xlLeft
-        .InsertIndent 3
+        .InsertIndent 1
+        .WrapText = False
     End With
     With nws.Range("L4")
-        .value = "------------Full Pallet----------"
+        .value = "--------Full Pallet-------"
         .HorizontalAlignment = xlLeft
-        .InsertIndent 3
+        .InsertIndent 1
+        .WrapText = False
     End With
     With nws.Range("O4")
-        .value = "------------Bulk Pallet----------"
+        .value = "--------Bulk Pallet-------"
         .HorizontalAlignment = xlLeft
-        .InsertIndent 3
+        .InsertIndent 1
+        .WrapText = False
     End With
     Application.DisplayAlerts = True
     
@@ -676,6 +687,8 @@ Sub build_customer_files()
         If nws.Cells(i, 12) = "" And (nws.Cells(i, 18) = "base" Or nws.Cells(i, 18) = "compatible") Then nws.Cells(i, 12) = "'"
         If nws.Cells(i, 14) = "" And (nws.Cells(i, 18) = "base" Or nws.Cells(i, 18) = "compatible") Then nws.Cells(i, 14) = "'"
         If nws.Cells(i, 15) = "" And (nws.Cells(i, 18) = "base" Or nws.Cells(i, 18) = "compatible") Then nws.Cells(i, 15) = "'"
+        '-------------------apply border------------------
+        If pricelevel.chbBorders And (nws.Cells(i, 18) = "base" Or nws.Cells(i, 18) = "compatible") Then Call border(nws, i, lastcol)
         '--------------------merge products---------------
         If nws.Cells(i, 1) = nws.Cells(i - 1, 1) And nws.Cells(i, 1) <> nws.Cells(i + 1, 1) Then
             'if the next row is different and the previous row is the same the loop back and merge the range
@@ -686,6 +699,12 @@ Sub build_customer_files()
             j = j + 1
             If j < 0 Then Call merge(nws, i + j, i)
         End If
+        '-------------------auto fit row for wrapped colors-------
+        nws.Rows(i).EntireRow.autofit
+        '-------------------reformat line breaks----------
+        'nws.Cells(i, 9) = split_and_rebuild(nws.Cells(i, 9))
+        'nws.Cells(i, 12) = split_and_rebuild(nws.Cells(i, 12))
+        'nws.Cells(i, 15) = split_and_rebuild(nws.Cells(i, 15))
             
     Next i
     
@@ -740,7 +759,7 @@ 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 & "\HC Companies Distributor Price List.xlsx"
     
     For Each wb In Workbooks
         If wb.Name = "HC FullCode List.xlsx" Then
@@ -753,7 +772,7 @@ Sub build_customer_files()
         End If
     Next wb
     
-    If pricelevel.tbPath.text <> "" Then fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx"
+    If pricelevel.tbPATH.text <> "" Then fcwb.SaveAs Filename:=filepath & "\HC FullCode List.xlsx"
 
     
 End Sub
@@ -898,6 +917,55 @@ Sub header(ByRef ws As Worksheet, row As Long, start_col As Long, end_col As Lon
 
 End Sub
 
+Sub border(ByRef ws As Worksheet, row As Long, lastcol As Long)
+
+    Dim target As Range
+    Set target = ws.Range(ws.Cells(row, 1), ws.Cells(row, lastcol))
+    If ws.Cells(row - 1, 18) <> "header" Then
+        With target.Borders(xlEdgeTop)
+            .LineStyle = xlContinuous
+            .ThemeColor = 1
+            .TintAndShade = -0.249946592608417
+            .Weight = xlThin
+        End With
+    End If
+    With target.Borders(xlInsideVertical)
+        .LineStyle = xlContinuous
+        .ThemeColor = 1
+        .TintAndShade = -0.249946592608417
+        .Weight = xlThin
+    End With
+        With target.Borders(xlInsideHorizontal)
+        .LineStyle = xlContinuous
+        .ThemeColor = 1
+        .TintAndShade = -0.249946592608417
+        .Weight = xlThin
+    End With
+
+End Sub
+
+Function split_and_rebuild(text As String) As String
+
+    Dim i As Long
+    Dim last As Long
+    Dim newt As String
+    
+    newt = ""
+    i = 1
+    last = 1
+    Do Until InStr(i, text, Chr(10)) = 0
+        i = InStr(i, text, Chr(10))
+        newt = newt & Mid(text, last, i - 1) & Chr(10)
+        last = i
+        i = i + 1
+    Loop
+    newt = newt & Mid(text, i, 100)
+    split_and_rebuild = newt
+    
+
+End Function
+
+
 Sub print_setup(sheet As Worksheet, last_row As Long)
 
     Dim Sel As Range
@@ -928,8 +996,8 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
     
     '-------------------force a page break on color codes----------
     j = 1
-    For i = 2 To last_row
+    For i = 5 To last_row
-        If j = 70 Then
+        If j = 60 Then
             sheet.HPageBreaks.Add before:=sheet.Rows(i + 1)
             j = 1
         End If
@@ -949,4 +1017,7 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
     
     Application.PrintCommunication = True
     
+    sheet.DisplayPageBreaks = False
+    
 End Sub
+

pricelevel.frm

@@ -34,7 +34,7 @@ Private Sub cbFolder_Click()
     Set fd = Application.FileDialog(msoFileDialogFolderPicker)
     fd.Show
     
-    tbPath.text = fd.SelectedItems(1)
+    tbPATH.text = fd.SelectedItems(1)
 End Sub