more formatting
This commit is contained in:
		
							parent
							
								
									261aece1ad
								
							
						
					
					
						commit
						22af739ffb
					
				
							
								
								
									
										124
									
								
								PriceLists.bas
									
									
									
									
									
								
							
							
						
						
									
										124
									
								
								PriceLists.bas
									
									
									
									
									
								
							@ -516,10 +516,11 @@ Sub build_pretty()
 | 
			
		||||
    Set nwb = Application.Workbooks.Add
 | 
			
		||||
    nwb.Activate
 | 
			
		||||
    Set nws = nwb.Sheets(1)
 | 
			
		||||
    Set nws.Name = "Price List"
 | 
			
		||||
    nws.Activate
 | 
			
		||||
    nws.Cells.NumberFormat = "@"
 | 
			
		||||
    nws.Name = "USD"
 | 
			
		||||
    nws.Cells.NumberFormat = "@" 'format all cells to text so pasted text values are not cast to numeric
 | 
			
		||||
    Call x.SHTp_Dump(pl, nws.Name, 5, 1, False, True)
 | 
			
		||||
    Application.ScreenUpdating = False
 | 
			
		||||
    
 | 
			
		||||
    '---------------------whole sheet formatting----------------------------------------------------------------
 | 
			
		||||
    nws.Columns(9).HorizontalAlignment = xlCenter
 | 
			
		||||
@ -531,16 +532,37 @@ Sub build_pretty()
 | 
			
		||||
    nws.Columns(15).HorizontalAlignment = xlCenter
 | 
			
		||||
    nws.Columns(16).HorizontalAlignment = xlRight
 | 
			
		||||
    nws.Columns(17).HorizontalAlignment = xlRight
 | 
			
		||||
    nws.Columns(1).ColumnWidth = 12
 | 
			
		||||
    nws.Columns(2).ColumnWidth = 70
 | 
			
		||||
    nws.Columns(3).ColumnWidth = 8.29
 | 
			
		||||
    nws.Columns(4).ColumnWidth = 4.86
 | 
			
		||||
    nws.Columns(5).ColumnWidth = 4.86
 | 
			
		||||
    nws.Columns(6).ColumnWidth = 4.86
 | 
			
		||||
    nws.Columns(7).ColumnWidth = 4.86
 | 
			
		||||
    nws.Columns(8).ColumnWidth = 11
 | 
			
		||||
    nws.Columns(9).ColumnWidth = 17.71
 | 
			
		||||
    nws.Columns(12).ColumnWidth = 17.71
 | 
			
		||||
    nws.Columns(15).ColumnWidth = 17.71
 | 
			
		||||
    nws.Columns(10).ColumnWidth = 10.57
 | 
			
		||||
    nws.Columns(13).ColumnWidth = 10.57
 | 
			
		||||
    nws.Columns(16).ColumnWidth = 10.57
 | 
			
		||||
    nws.Columns(11).ColumnWidth = 11.71
 | 
			
		||||
    nws.Columns(14).ColumnWidth = 11.71
 | 
			
		||||
    nws.Columns(17).ColumnWidth = 11.71
 | 
			
		||||
    ActiveWindow.DisplayGridlines = False
 | 
			
		||||
    Columns("B:B").EntireColumn.autofit
 | 
			
		||||
    Columns("A:A").ColumnWidth = 10.71
 | 
			
		||||
    nws.Cells.Font.Name = "Cascadia Code Light"
 | 
			
		||||
    nws.Cells.Font.Size = 10
 | 
			
		||||
    Rows("6:6").Select
 | 
			
		||||
    ActiveWindow.FreezePanes = True
 | 
			
		||||
    nws.Cells(2, 3).value = "Distributor Price List (USD) - Effective 6/1/2022"
 | 
			
		||||
        
 | 
			
		||||
    '---------------------logo----------------------------------------------------------------------------------
 | 
			
		||||
    ActiveSheet.Cells(1, 1).Select
 | 
			
		||||
    ActiveSheet.Pictures.Insert("https://hc-companies.com/wp-content/themes/hc-companies/images/logo.svg").Select
 | 
			
		||||
    Selection.ShapeRange.ScaleHeight 0.6, msoFalse, msoScaleFromTopLeft
 | 
			
		||||
    Selection.ShapeRange.IncrementLeft 2
 | 
			
		||||
    Selection.ShapeRange.IncrementTop 2
 | 
			
		||||
    ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes.Item(1), address:="https://hc-companies.com/"
 | 
			
		||||
    ActiveSheet.Cells(5, 1).Select
 | 
			
		||||
    
 | 
			
		||||
    '---------------------header formatting---------------------------------------------------------------------
 | 
			
		||||
@ -548,9 +570,21 @@ Sub build_pretty()
 | 
			
		||||
        c.value = Left(c.value, Len(c.value) - 1)
 | 
			
		||||
    Next c
 | 
			
		||||
    Application.DisplayAlerts = False
 | 
			
		||||
    nws.Range("I4:K4").MergeCells = True
 | 
			
		||||
    nws.Range("L4:N4").MergeCells = True
 | 
			
		||||
    nws.Range("O4:Q4").MergeCells = True
 | 
			
		||||
    With nws.Range("I4")
 | 
			
		||||
        .value = "-----------Single Package--------"
 | 
			
		||||
        .HorizontalAlignment = xlLeft
 | 
			
		||||
        .InsertIndent 3
 | 
			
		||||
    End With
 | 
			
		||||
    With nws.Range("L4")
 | 
			
		||||
        .value = "------------Full Pallet----------"
 | 
			
		||||
        .HorizontalAlignment = xlLeft
 | 
			
		||||
        .InsertIndent 3
 | 
			
		||||
    End With
 | 
			
		||||
    With nws.Range("O4")
 | 
			
		||||
        .value = "------------Bulk Pallet----------"
 | 
			
		||||
        .HorizontalAlignment = xlLeft
 | 
			
		||||
        .InsertIndent 3
 | 
			
		||||
    End With
 | 
			
		||||
    Application.DisplayAlerts = True
 | 
			
		||||
    
 | 
			
		||||
    '---------------------find size of table---------------------------------------------------------------------
 | 
			
		||||
@ -562,13 +596,24 @@ Sub build_pretty()
 | 
			
		||||
    lastcol = 17
 | 
			
		||||
    
 | 
			
		||||
    '--------------------line formatting--------------------------------------------------------------------------
 | 
			
		||||
    Application.ScreenUpdating = False
 | 
			
		||||
    For i = 6 To last
 | 
			
		||||
        If nws.Cells(i, 18) = "header" Then Call pretty_green(nws, i, 1, lastcol)
 | 
			
		||||
        '--------------------format header---------------
 | 
			
		||||
        If nws.Cells(i, 18) = "header" Then Call header(nws, i, 1, lastcol)
 | 
			
		||||
        '--------------------create bands---------------
 | 
			
		||||
        If nws.Cells(i, 20) = "1" And Not nws.Cells(i, 18) = "header" Then Call banding(nws, i, 1, lastcol)
 | 
			
		||||
        '--------------------indent compatible---------------
 | 
			
		||||
        If nws.Cells(i, 18) = "compatible" Then Call compatible(nws, i, 1, 2)
 | 
			
		||||
        '----if the next row is different and the previous row is the same the loop back and merge the range------
 | 
			
		||||
        '--------------------highlight price---------------
 | 
			
		||||
        If nws.Cells(i, 18) <> "header" Then Call price_col(nws, i, 20)
 | 
			
		||||
        '--------------------comment empy qty to prevent colors from spilling
 | 
			
		||||
        If nws.Cells(i, 9) = "" Then nws.Cells(i, 9) = "'"
 | 
			
		||||
        If nws.Cells(i, 11) = "" Then nws.Cells(i, 11) = "'"
 | 
			
		||||
        If nws.Cells(i, 12) = "" Then nws.Cells(i, 12) = "'"
 | 
			
		||||
        If nws.Cells(i, 14) = "" Then nws.Cells(i, 14) = "'"
 | 
			
		||||
        If nws.Cells(i, 15) = "" Then nws.Cells(i, 15) = "'"
 | 
			
		||||
        '--------------------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
 | 
			
		||||
            j = -1
 | 
			
		||||
            Do Until nws.Cells(i + j, 1) <> nws.Cells(i, 1)
 | 
			
		||||
                j = j - 1
 | 
			
		||||
@ -577,8 +622,12 @@ Sub build_pretty()
 | 
			
		||||
            If j < 0 Then Call merge(nws, i + j, i)
 | 
			
		||||
        End If
 | 
			
		||||
    Next i
 | 
			
		||||
    nws.Columns("R:T").Delete
 | 
			
		||||
    nws.Cells(5, 1).Select
 | 
			
		||||
    Application.ScreenUpdating = True
 | 
			
		||||
    
 | 
			
		||||
    Call page_setup
 | 
			
		||||
    
 | 
			
		||||
    '--------------------save file--------------------------------------------------------------------------------
 | 
			
		||||
    'prettyfilepath = "C:\Users\PTrowbridge\Downloads\PriceListPackage\" & "U.AAA.DI" & "\" & "HC Companies Distributor Price List.xlsx"
 | 
			
		||||
    'Call nwb.SaveAs(prettyfilepath, "XLSX")
 | 
			
		||||
@ -592,6 +641,39 @@ Function rrange(ByRef sheet As Worksheet, start_row As Long, end_row As Long, st
 | 
			
		||||
 | 
			
		||||
End Function
 | 
			
		||||
 | 
			
		||||
Sub price_col(ByRef sheet As Worksheet, row As Long, flag_col As Long)
 | 
			
		||||
 | 
			
		||||
    Dim Sel As Range
 | 
			
		||||
    Dim i As Long
 | 
			
		||||
    
 | 
			
		||||
    i = 0
 | 
			
		||||
    Do Until i = 9
 | 
			
		||||
        Set Sel = rrange(sheet, row, row, 10 + i, 10 + i)
 | 
			
		||||
 | 
			
		||||
        If sheet.Cells(row, flag_col) = "0" Then
 | 
			
		||||
            With Sel.Interior
 | 
			
		||||
                .Pattern = xlSolid
 | 
			
		||||
                .PatternColorIndex = xlAutomatic
 | 
			
		||||
                .ThemeColor = xlThemeColorAccent4
 | 
			
		||||
                .TintAndShade = 0.799981688894314
 | 
			
		||||
                .PatternTintAndShade = 0
 | 
			
		||||
            End With
 | 
			
		||||
        Else
 | 
			
		||||
            With Sel.Interior
 | 
			
		||||
                .Pattern = xlSolid
 | 
			
		||||
                .PatternColorIndex = xlAutomatic
 | 
			
		||||
                .ThemeColor = xlThemeColorAccent4
 | 
			
		||||
                .TintAndShade = 0.599993896298105
 | 
			
		||||
                .PatternTintAndShade = 0
 | 
			
		||||
            End With
 | 
			
		||||
        End If
 | 
			
		||||
        i = i + 3
 | 
			
		||||
    Loop
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
End Sub
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
Sub merge(ByRef ws As Worksheet, start_row As Long, end_row As Long)
 | 
			
		||||
 | 
			
		||||
    Dim Sel As Range
 | 
			
		||||
@ -646,12 +728,14 @@ Sub banding(ByRef ws As Worksheet, row As Long, start_col As Long, end_col As Lo
 | 
			
		||||
 | 
			
		||||
End Sub
 | 
			
		||||
 | 
			
		||||
Sub pretty_green(ByRef ws As Worksheet, row As Long, start_col As Long, end_col As Long)
 | 
			
		||||
Sub header(ByRef ws As Worksheet, row As Long, start_col As Long, end_col As Long)
 | 
			
		||||
 | 
			
		||||
    Dim Sel As Range
 | 
			
		||||
    
 | 
			
		||||
    Set Sel = rrange(ws, row, row, start_col, end_col)
 | 
			
		||||
 | 
			
		||||
    Sel.InsertIndent 2
 | 
			
		||||
    Sel.Font.Size = 11
 | 
			
		||||
    With Sel.Interior
 | 
			
		||||
        .Pattern = xlSolid
 | 
			
		||||
        .PatternColorIndex = xlAutomatic
 | 
			
		||||
@ -691,5 +775,23 @@ Sub pretty_green(ByRef ws As Worksheet, row As Long, start_col As Long, end_col
 | 
			
		||||
 | 
			
		||||
End Sub
 | 
			
		||||
 | 
			
		||||
Sub print_setup(sheet As Worksheet, last_row As Long)
 | 
			
		||||
 | 
			
		||||
    Dim Sel As Range
 | 
			
		||||
    
 | 
			
		||||
    Set Sel = rrange(sheet, 6, last_row, 1, 17)
 | 
			
		||||
 | 
			
		||||
    With sheet.PageSetup
 | 
			
		||||
        .PrintArea = Sel.address
 | 
			
		||||
        .PrintTitleRows = "$1:$5"
 | 
			
		||||
        .LeftMargin = Application.InchesToPoints(0.7)
 | 
			
		||||
        .RightMargin = Application.InchesToPoints(0.7)
 | 
			
		||||
        .TopMargin = Application.InchesToPoints(0.75)
 | 
			
		||||
        .BottomMargin = Application.InchesToPoints(0.75)
 | 
			
		||||
        .HeaderMargin = Application.InchesToPoints(0.3)
 | 
			
		||||
        .FooterMargin = Application.InchesToPoints(0.3)
 | 
			
		||||
        .Orientation = xlLandscape
 | 
			
		||||
        .FitToPagesWide = 1
 | 
			
		||||
    End With
 | 
			
		||||
    
 | 
			
		||||
End Sub
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user