From e277b326c716c115c1e59905c845a0f8720a70fd Mon Sep 17 00:00:00 2001 From: Paul Trowbridge Date: Fri, 27 May 2022 00:26:36 -0400 Subject: [PATCH] formatting and add checkboxes to form --- PriceLists.bas | 109 ++++++++++++++++++++++++++++++++++++++++--------- pricelevel.frm | 2 +- pricelevel.frx | Bin 3608 -> 3608 bytes 3 files changed, 91 insertions(+), 20 deletions(-) diff --git a/PriceLists.bas b/PriceLists.bas index ea5bfb0..b988aad 100644 --- a/PriceLists.bas +++ b/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 - nws.Columns(8).ColumnWidth = 11 - nws.Columns(9).ColumnWidth = 17.71 - nws.Columns(12).ColumnWidth = 17.71 - nws.Columns(15).ColumnWidth = 17.71 + If pricelevel.chbColors Then + nws.Columns(8).ColumnWidth = 17 + nws.Columns(8).WrapText = True + Else + nws.Columns(8).ColumnWidth = 11 + End If + nws.Columns(9).ColumnWidth = 8.29 + 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 - If j = 70 Then + For i = 5 To last_row + 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 + diff --git a/pricelevel.frm b/pricelevel.frm index 463b300..8001ba5 100644 --- a/pricelevel.frm +++ b/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 diff --git a/pricelevel.frx b/pricelevel.frx index 77016448063732a6cc73dc34303c0b0b96c3ac97..1b4494e448355499a73bcea331d20ff2c1763be2 100644 GIT binary patch delta 465 zcmbOsGec%W3yY{g_3b^4g*Oo|Fs5(_5xa9*-^U~pqR&;Zl|vb6zdTLTM_4K$+xXj{W0p!wB6 z4;e~7U<}U4FIVu)D@iTN%r8=K$}dVuEh?V;kVDbN2B#Sy^WbIx&2`BvF33r&RB+76 zQE<-B$p;!>#}x&1>`X3YP;gG(&-E*TsS;#mpE8iopuzAI=oVlgHShv?2|&!rAjOcJ xkp#7$f#HZO1H&CPpafJcCr~XYRAPXb3!)ZclO|IoNUgTk?t69z>1-q=svc&H21@oRPrk~d&&$NaAPF?;b3G%& Vf5yp%EYgc5co`>8;Ozk73IIhuJ%IoK