currency, save file, and eff date
This commit is contained in:
parent
b96be55725
commit
b1a4d149d3
@ -497,17 +497,22 @@ Sub build_pretty()
|
||||
Dim pl() As String
|
||||
Dim nwb As Workbook
|
||||
Dim nws As Worksheet
|
||||
Dim prettyfilepath As String
|
||||
Dim filepath As String
|
||||
Dim c As Range
|
||||
Dim i As Long
|
||||
Dim j As Long
|
||||
Dim last As Long
|
||||
Dim lastcol As Long
|
||||
Dim clist() As String
|
||||
Dim curr As String
|
||||
Dim plev As String
|
||||
Dim effdate As Date
|
||||
|
||||
'---------------------get price list------------------------------------------------------------------------
|
||||
login.Show
|
||||
plev = InputBox("Price Level")
|
||||
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")
|
||||
pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "')", 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
|
||||
@ -518,7 +523,6 @@ Sub build_pretty()
|
||||
nwb.Activate
|
||||
Set nws = nwb.Sheets(1)
|
||||
nws.Activate
|
||||
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
|
||||
@ -555,7 +559,6 @@ Sub build_pretty()
|
||||
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
|
||||
@ -623,15 +626,42 @@ Sub build_pretty()
|
||||
If j < 0 Then Call merge(nws, i + j, i)
|
||||
End If
|
||||
Next i
|
||||
nws.Columns("R:T").Delete
|
||||
pl = x.TBLp_Transpose(pl)
|
||||
Call x.TBLp_Group(pl, True, x.ARRAYp_MakeInteger(20))
|
||||
If UBound(pl, 2) > 1 Then
|
||||
'---somehow multiple currencies involved----
|
||||
MsgBox ("multiple currencies")
|
||||
Exit Sub
|
||||
Else
|
||||
Select Case pl(20, 1)
|
||||
Case "C"
|
||||
curr = "CAD"
|
||||
Case "U"
|
||||
curr = "USD"
|
||||
Case Else
|
||||
MsgBox ("unknown currency - " & pl(20, 1))
|
||||
End Select
|
||||
End If
|
||||
effdate = "06/01/2022"
|
||||
nws.Cells(2, 3).value = "Distributor Price List (" & curr & ") - Effective " & Format(effdate, "MM/DD/YYYY")
|
||||
nws.Name = curr
|
||||
nws.Columns("R:U").Delete
|
||||
nws.Cells(5, 1).Select
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
Call print_setup(nws, last)
|
||||
|
||||
|
||||
'--------------------save file--------------------------------------------------------------------------------
|
||||
'prettyfilepath = "C:\Users\PTrowbridge\Downloads\PriceListPackage\" & "U.AAA.DI" & "\" & "HC Companies Distributor Price List.xlsx"
|
||||
'Call nwb.SaveAs(prettyfilepath, "XLSX")
|
||||
Dim fd As Object
|
||||
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
|
||||
fd.Show
|
||||
filepath = fd.SelectedItems(1) & "\" & plev
|
||||
With CreateObject("Scripting.FileSystemObject")
|
||||
If Not .FolderExists(filepath) Then .CreateFolder filepath
|
||||
End With
|
||||
nwb.SaveAs Filename:=filepath & "\HC Companies Distributor Price List.xlsx"
|
||||
nwb.Activate
|
||||
|
||||
|
||||
End Sub
|
||||
@ -796,10 +826,13 @@ Sub print_setup(sheet As Worksheet, last_row As Long)
|
||||
.FooterMargin = Application.InchesToPoints(0.25)
|
||||
End With
|
||||
|
||||
sheet.DisplayPageBreaks = False
|
||||
|
||||
End Sub
|
||||
|
||||
Sub call_print()
|
||||
|
||||
Call print_setup(ActiveSheet, 960)
|
||||
Call print_setup(ActiveSheet, 1120)
|
||||
|
||||
End Sub
|
||||
|
||||
|
15
pricelevel.frm
Normal file
15
pricelevel.frm
Normal file
@ -0,0 +1,15 @@
|
||||
VERSION 5.00
|
||||
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelevel
|
||||
Caption = "Build Customer Price List"
|
||||
ClientHeight = 3960
|
||||
ClientLeft = 120
|
||||
ClientTop = 465
|
||||
ClientWidth = 4335
|
||||
OleObjectBlob = "pricelevel.frx":0000
|
||||
StartUpPosition = 1 'CenterOwner
|
||||
End
|
||||
Attribute VB_Name = "pricelevel"
|
||||
Attribute VB_GlobalNameSpace = False
|
||||
Attribute VB_Creatable = False
|
||||
Attribute VB_PredeclaredId = True
|
||||
Attribute VB_Exposed = False
|
BIN
pricelevel.frx
Normal file
BIN
pricelevel.frx
Normal file
Binary file not shown.
Loading…
Reference in New Issue
Block a user