create page breaks for notes and dont do coloring. manually set all the page breaks

This commit is contained in:
Paul Trowbridge 2022-05-17 16:26:20 -04:00
parent aee26ac1a3
commit 1c6a6cc848
2 changed files with 33 additions and 8 deletions

View File

@ -616,13 +616,13 @@ Sub build_pretty()
'--------------------indent compatible--------------- '--------------------indent compatible---------------
If nws.Cells(i, 18) = "compatible" Then Call compatible(nws, i, 1, 2) If nws.Cells(i, 18) = "compatible" Then Call compatible(nws, i, 1, 2)
'--------------------highlight price--------------- '--------------------highlight price---------------
If nws.Cells(i, 18) <> "header" Then Call price_col(nws, i, 20) If nws.Cells(i, 18) = "base" Or nws.Cells(i, 18) = "compatible" Then Call price_col(nws, i, 20)
'--------------------comment empy qty to prevent colors from spilling '--------------------comment empy qty to prevent colors from spilling
If nws.Cells(i, 9) = "" Then nws.Cells(i, 9) = "'" If nws.Cells(i, 9) = "" And (nws.Cells(i, 18) = "base" Or nws.Cells(i, 18) = "compatible") Then nws.Cells(i, 9) = "'"
If nws.Cells(i, 11) = "" Then nws.Cells(i, 11) = "'" If nws.Cells(i, 11) = "" And (nws.Cells(i, 18) = "base" Or nws.Cells(i, 18) = "compatible") Then nws.Cells(i, 11) = "'"
If nws.Cells(i, 12) = "" Then nws.Cells(i, 12) = "'" 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) = "" Then nws.Cells(i, 14) = "'" 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) = "" Then nws.Cells(i, 15) = "'" If nws.Cells(i, 15) = "" And (nws.Cells(i, 18) = "base" Or nws.Cells(i, 18) = "compatible") Then nws.Cells(i, 15) = "'"
'--------------------merge products--------------- '--------------------merge products---------------
If nws.Cells(i, 1) = nws.Cells(i - 1, 1) And nws.Cells(i, 1) <> nws.Cells(i + 1, 1) Then 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 'if the next row is different and the previous row is the same the loop back and merge the range
@ -633,8 +633,10 @@ Sub build_pretty()
j = j + 1 j = j + 1
If j < 0 Then Call merge(nws, i + j, i) If j < 0 Then Call merge(nws, i + j, i)
End If End If
Next i Next i
pl = x.TBLp_Transpose(pl) pl = x.TBLp_Transpose(pl)
Call x.TBLp_FilterSingle(pl, 20, "", False)
Call x.TBLp_Group(pl, True, x.ARRAYp_MakeInteger(20)) Call x.TBLp_Group(pl, True, x.ARRAYp_MakeInteger(20))
If UBound(pl, 2) > 1 Then If UBound(pl, 2) > 1 Then
'---somehow multiple currencies involved---- '---somehow multiple currencies involved----
@ -652,12 +654,13 @@ Sub build_pretty()
End If End If
nws.Cells(2, 3).value = "Distributor Price List (" & curr & ") - Effective " & Format(effdate, "MM/DD/YYYY") nws.Cells(2, 3).value = "Distributor Price List (" & curr & ") - Effective " & Format(effdate, "MM/DD/YYYY")
nws.Name = curr nws.Name = curr
nws.Columns("R:V").Delete
nws.Cells(5, 1).Select nws.Cells(5, 1).Select
Application.ScreenUpdating = True
Call print_setup(nws, last) Call print_setup(nws, last)
nws.Columns("R:V").Delete
Application.ScreenUpdating = True
'--------------------save file-------------------------------------------------------------------------------- '--------------------save file--------------------------------------------------------------------------------
'Dim fd As Object 'Dim fd As Object
@ -830,6 +833,8 @@ End Sub
Sub print_setup(sheet As Worksheet, last_row As Long) Sub print_setup(sheet As Worksheet, last_row As Long)
Dim Sel As Range Dim Sel As Range
Dim i As Long
Dim j As Long
Set Sel = rrange(sheet, 6, last_row, 1, 17) Set Sel = rrange(sheet, 6, last_row, 1, 17)
@ -852,6 +857,26 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
sheet.PageSetup.FitToPagesWide = 1 sheet.PageSetup.FitToPagesWide = 1
sheet.PageSetup.FitToPagesTall = 0 sheet.PageSetup.FitToPagesTall = 0
'-------------------force a page break on color codes----------
j = 1
For i = 2 To last_row
If j = 70 Then
sheet.HPageBreaks.Add before:=sheet.Rows(i + 1)
j = 1
End If
'every 73 rows is a page break for current font
If sheet.Cells(i, 18) = "colors" And sheet.Cells(i - 1, 18) <> "colors" Then
sheet.HPageBreaks.Add before:=sheet.Rows(i)
j = 1
End If
If sheet.Cells(i, 18) = "notes" And sheet.Cells(i - 1, 18) <> "notes" Then
sheet.HPageBreaks.Add before:=sheet.Rows(i)
j = 1
End If
j = j + 1
Next i
sheet.DisplayPageBreaks = False sheet.DisplayPageBreaks = False
Application.PrintCommunication = True Application.PrintCommunication = True

Binary file not shown.