turn of screen updating for test; start work on building price list file
This commit is contained in:
parent
ed4c795a40
commit
261aece1ad
211
PriceLists.bas
211
PriceLists.bas
|
|
@ -42,6 +42,8 @@ Sub test_full20()
|
|||
Exit Sub
|
||||
End If
|
||||
|
||||
Application.ScreenUpdating = False
|
||||
|
||||
With orig.Interior
|
||||
.Pattern = xlNone
|
||||
.TintAndShade = 0
|
||||
|
|
@ -88,7 +90,7 @@ Sub test_full20()
|
|||
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
|
||||
|
|
@ -189,6 +191,7 @@ Sub test_full20()
|
|||
Selection.Columns(pcol(i) + 1).Interior.Pattern = xlNone
|
||||
Next i
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
'----------------------------cleanup-------------------------------------------------------------
|
||||
|
||||
|
|
@ -484,3 +487,209 @@ Function unpivot_current_sheet(ByRef lists() As String, ByRef pcol() As Long) As
|
|||
unpivot_current_sheet = load
|
||||
|
||||
End Function
|
||||
|
||||
get_price
|
||||
|
||||
Sub build_pretty()
|
||||
|
||||
Dim x As New TheBigOne
|
||||
Dim pl() As String
|
||||
Dim nwb As Workbook
|
||||
Dim nws As Worksheet
|
||||
Dim prettyfilepath As String
|
||||
Dim c As Range
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim last As Long
|
||||
Dim lastcol As Long
|
||||
|
||||
'---------------------get price list------------------------------------------------------------------------
|
||||
login.Show
|
||||
If Not login.proceed Then Exit Sub
|
||||
pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('U.AAA.DI')", False, 2000, True, PostgreSQLODBC, "usmidlnx01", False, login.tbU.text, login.tbP.text, "Port=5030;Database=ubm")
|
||||
If pl(0, 0) <> "Product" Then
|
||||
MsgBox (pl(0, 0))
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
'---------------------create new workbook-------------------------------------------------------------------
|
||||
Set nwb = Application.Workbooks.Add
|
||||
nwb.Activate
|
||||
Set nws = nwb.Sheets(1)
|
||||
Set nws.Name = "Price List"
|
||||
nws.Activate
|
||||
nws.Cells.NumberFormat = "@"
|
||||
Call x.SHTp_Dump(pl, nws.Name, 5, 1, False, True)
|
||||
|
||||
'---------------------whole sheet formatting----------------------------------------------------------------
|
||||
nws.Columns(9).HorizontalAlignment = xlCenter
|
||||
nws.Columns(10).HorizontalAlignment = xlRight
|
||||
nws.Columns(11).HorizontalAlignment = xlRight
|
||||
nws.Columns(12).HorizontalAlignment = xlCenter
|
||||
nws.Columns(13).HorizontalAlignment = xlRight
|
||||
nws.Columns(14).HorizontalAlignment = xlRight
|
||||
nws.Columns(15).HorizontalAlignment = xlCenter
|
||||
nws.Columns(16).HorizontalAlignment = xlRight
|
||||
nws.Columns(17).HorizontalAlignment = xlRight
|
||||
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
|
||||
|
||||
'---------------------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
|
||||
ActiveSheet.Cells(5, 1).Select
|
||||
|
||||
'---------------------header formatting---------------------------------------------------------------------
|
||||
For Each c In Range("I5:Q5").Cells
|
||||
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
|
||||
Application.DisplayAlerts = True
|
||||
|
||||
'---------------------find size of table---------------------------------------------------------------------
|
||||
i = 6
|
||||
Do Until nws.Cells(i, 18) = ""
|
||||
i = i + 1
|
||||
Loop
|
||||
last = i - 1
|
||||
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)
|
||||
If nws.Cells(i, 20) = "1" And Not nws.Cells(i, 18) = "header" Then Call banding(nws, i, 1, lastcol)
|
||||
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------
|
||||
If nws.Cells(i, 1) = nws.Cells(i - 1, 1) And nws.Cells(i, 1) <> nws.Cells(i + 1, 1) Then
|
||||
j = -1
|
||||
Do Until nws.Cells(i + j, 1) <> nws.Cells(i, 1)
|
||||
j = j - 1
|
||||
Loop
|
||||
j = j + 1
|
||||
If j < 0 Then Call merge(nws, i + j, i)
|
||||
End If
|
||||
Next i
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
'--------------------save file--------------------------------------------------------------------------------
|
||||
'prettyfilepath = "C:\Users\PTrowbridge\Downloads\PriceListPackage\" & "U.AAA.DI" & "\" & "HC Companies Distributor Price List.xlsx"
|
||||
'Call nwb.SaveAs(prettyfilepath, "XLSX")
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Function rrange(ByRef sheet As Worksheet, start_row As Long, end_row As Long, start_col As Long, end_col As Long) As Range
|
||||
|
||||
Set rrange = Range(sheet.Cells(start_row, start_col).address & ":" & sheet.Cells(end_row, end_col).address)
|
||||
|
||||
End Function
|
||||
|
||||
Sub merge(ByRef ws As Worksheet, start_row As Long, end_row As Long)
|
||||
|
||||
Dim Sel As Range
|
||||
Dim i As Long
|
||||
|
||||
Application.DisplayAlerts = False
|
||||
|
||||
For i = 1 To 2
|
||||
Set Sel = rrange(ws, start_row, end_row, i, i)
|
||||
|
||||
With Sel
|
||||
.HorizontalAlignment = xlLeft
|
||||
.VerticalAlignment = xlCenter
|
||||
.WrapText = False
|
||||
.Orientation = 0
|
||||
.AddIndent = False
|
||||
.IndentLevel = 0
|
||||
.ShrinkToFit = False
|
||||
.ReadingOrder = xlContext
|
||||
.MergeCells = True
|
||||
End With
|
||||
Next i
|
||||
|
||||
Application.DisplayAlerts = True
|
||||
|
||||
End Sub
|
||||
|
||||
Sub compatible(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
|
||||
|
||||
End Sub
|
||||
|
||||
Sub banding(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)
|
||||
|
||||
With Sel.Interior
|
||||
.Pattern = xlSolid
|
||||
.PatternColorIndex = xlAutomatic
|
||||
.ThemeColor = xlThemeColorAccent3
|
||||
.TintAndShade = 0.799981688894314
|
||||
.PatternTintAndShade = 0
|
||||
End With
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
Sub pretty_green(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)
|
||||
|
||||
With Sel.Interior
|
||||
.Pattern = xlSolid
|
||||
.PatternColorIndex = xlAutomatic
|
||||
.ThemeColor = xlThemeColorAccent6
|
||||
.TintAndShade = 0.799981688894314
|
||||
.PatternTintAndShade = 0
|
||||
End With
|
||||
Sel.Borders(xlDiagonalDown).LineStyle = xlNone
|
||||
Sel.Borders(xlDiagonalUp).LineStyle = xlNone
|
||||
With Sel.Borders(xlEdgeLeft)
|
||||
.LineStyle = xlContinuous
|
||||
.ThemeColor = 1
|
||||
.TintAndShade = 0
|
||||
.Weight = xlThick
|
||||
End With
|
||||
With Sel.Borders(xlEdgeTop)
|
||||
.LineStyle = xlContinuous
|
||||
.ThemeColor = 1
|
||||
.TintAndShade = 0
|
||||
.Weight = xlThick
|
||||
End With
|
||||
With Sel.Borders(xlEdgeBottom)
|
||||
.LineStyle = xlContinuous
|
||||
.ThemeColor = 1
|
||||
.TintAndShade = 0
|
||||
.Weight = xlThick
|
||||
End With
|
||||
With Sel.Borders(xlEdgeRight)
|
||||
.LineStyle = xlContinuous
|
||||
.ThemeColor = 1
|
||||
.TintAndShade = 0
|
||||
.Weight = xlThick
|
||||
End With
|
||||
Sel.Borders(xlInsideVertical).LineStyle = xlNone
|
||||
Sel.Borders(xlInsideHorizontal).LineStyle = xlNone
|
||||
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue