include currency in name of full code file
This commit is contained in:
parent
015f2679f9
commit
0f7b5db8b8
185
PriceLists.bas
185
PriceLists.bas
@ -545,6 +545,98 @@ Sub build_price_level(plev As String)
|
||||
effdate = CDate(pricelevel.tbEddDate.text)
|
||||
filepath = pricelevel.tbPATH & "\" & plev
|
||||
|
||||
'---------------------create new workbook-------------------------------------------------------------------
|
||||
Set nwb = Application.Workbooks.Add
|
||||
nwb.Activate
|
||||
Set nws = nwb.Sheets(1)
|
||||
segment_regex = "^G|^N|^F|^P"
|
||||
|
||||
'---------------------get price list------------------------------------------------------------------------
|
||||
If pricelevel.chbNURSERY Then
|
||||
pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm")
|
||||
If pln(0, 0) <> "Product" Then
|
||||
MsgBox (pln(0, 0))
|
||||
Exit Sub
|
||||
End If
|
||||
If UBound(pln, 2) > 21 Then
|
||||
segment_regex = "^F|^G|^P"
|
||||
Set nnws = nwb.Sheets.Add(, nws)
|
||||
nnws.Name = "Price List - Nursery"
|
||||
Call paste_pretty(pln, nnws, effdate, curr)
|
||||
End If
|
||||
End If
|
||||
|
||||
If pricelevel.chbFIBER Then
|
||||
plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm")
|
||||
If plf(0, 0) <> "Product" Then
|
||||
MsgBox (plf(0, 0))
|
||||
Exit Sub
|
||||
End If
|
||||
If UBound(plf, 2) > 21 Then
|
||||
If segment_regex = "^F|^G|^P" Then
|
||||
segment_regex = "^G|^P"
|
||||
Else
|
||||
segment_regex = "^G|^N|^P"
|
||||
End If
|
||||
Set nfws = nwb.Sheets.Add(, nws)
|
||||
nfws.Name = "Price List - Fiber"
|
||||
Call paste_pretty(plf, nfws, effdate, curr)
|
||||
End If
|
||||
End If
|
||||
|
||||
pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm")
|
||||
If pl(0, 0) <> "Product" Then
|
||||
MsgBox (pl(0, 0))
|
||||
Exit Sub
|
||||
End If
|
||||
If UBound(pl, 2) > 21 Then
|
||||
nws.Name = "Price list"
|
||||
Call paste_pretty(pl, nws, effdate, curr)
|
||||
Else
|
||||
'---if the price list has no length, then close
|
||||
nwb.Close
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
'--------------------save file--------------------------------------------------------------------------------
|
||||
'Dim fd As Object
|
||||
'Set fd = Application.FileDialog(msoFileDialogFolderPicker)
|
||||
'fd.Show
|
||||
'If fd.SelectedItems.Count = 0 Then Exit Sub
|
||||
With CreateObject("Scripting.FileSystemObject")
|
||||
If Not .FolderExists(filepath) Then .CreateFolder filepath
|
||||
End With
|
||||
Application.DisplayAlerts = True
|
||||
nwb.Activate
|
||||
|
||||
fname = "HC Companies Distributor Price List " & curr & ".xlsx"
|
||||
|
||||
Dim wb As Workbook
|
||||
For Each wb In Workbooks
|
||||
If wb.Name = fname Then
|
||||
If MsgBox("already have a price list open, close it?", vbOKCancel) Then
|
||||
Workbooks(fname).Close
|
||||
Exit For
|
||||
Else
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next wb
|
||||
|
||||
If pricelevel.tbPATH.text <> "" Then nwb.SaveAs Filename:=filepath & "\" & fname
|
||||
|
||||
If pricelevel.chPDF Then
|
||||
fname = Replace(fname, "xlsx", "pdf")
|
||||
nwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
|
||||
End If
|
||||
|
||||
If Not pricelevel.chbLEAVEOPEN Then
|
||||
nwb.Close
|
||||
End If
|
||||
|
||||
'--------------------get full code list-----------------------------
|
||||
If pricelevel.chbFULLCODE Then
|
||||
'---------------------get full code list--------------------------------------------------------------------
|
||||
fc = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_fullcode_cust('" & plev & "', '" & effdate & "'::date)", False, 20000, True, PostgreSQLODBC, "10.56.60.254", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm")
|
||||
@ -627,97 +719,8 @@ Sub build_price_level(plev As String)
|
||||
Application.PrintCommunication = True
|
||||
End If
|
||||
|
||||
'Application.ScreenUpdating = True
|
||||
'Exit Sub
|
||||
|
||||
'---------------------create new workbook-------------------------------------------------------------------
|
||||
Set nwb = Application.Workbooks.Add
|
||||
nwb.Activate
|
||||
Set nws = nwb.Sheets(1)
|
||||
segment_regex = "^G|^N|^F|^P"
|
||||
|
||||
'---------------------get price list------------------------------------------------------------------------
|
||||
If pricelevel.chbNURSERY Then
|
||||
pln = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "', '^N')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm")
|
||||
If pln(0, 0) <> "Product" Then
|
||||
MsgBox (pln(0, 0))
|
||||
Exit Sub
|
||||
End If
|
||||
If UBound(pln, 2) > 21 Then
|
||||
segment_regex = "^F|^G|^P"
|
||||
Set nnws = nwb.Sheets.Add(, nws)
|
||||
nnws.Name = "Price List - Nursery"
|
||||
Call paste_pretty(pln, nnws, effdate, curr)
|
||||
End If
|
||||
End If
|
||||
|
||||
If pricelevel.chbFIBER Then
|
||||
plf = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','^F')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm")
|
||||
If plf(0, 0) <> "Product" Then
|
||||
MsgBox (plf(0, 0))
|
||||
Exit Sub
|
||||
End If
|
||||
If UBound(plf, 2) > 21 Then
|
||||
If segment_regex = "^F|^G|^P" Then
|
||||
segment_regex = "^G|^P"
|
||||
Else
|
||||
segment_regex = "^G|^N|^P"
|
||||
End If
|
||||
Set nfws = nwb.Sheets.Add(, nws)
|
||||
nfws.Name = "Price List - Fiber"
|
||||
Call paste_pretty(plf, nfws, effdate, curr)
|
||||
End If
|
||||
End If
|
||||
|
||||
pl = x.ADOp_SelectS(0, "SELECT * FROM rlarp.plcore_build_pretty('" & plev & "','" & segment_regex & "')", False, 2000, True, PostgreSQLODBC, "usmidsap01", False, login.tbU.text, login.tbP.text, "Port=5432;Database=ubm")
|
||||
If pl(0, 0) <> "Product" Then
|
||||
MsgBox (pl(0, 0))
|
||||
Exit Sub
|
||||
End If
|
||||
If UBound(pl, 2) > 21 Then
|
||||
nws.Name = "Price list"
|
||||
Call paste_pretty(pl, nws, effdate, curr)
|
||||
Else
|
||||
nws.Delete
|
||||
End If
|
||||
|
||||
Application.ScreenUpdating = True
|
||||
|
||||
'--------------------save file--------------------------------------------------------------------------------
|
||||
'Dim fd As Object
|
||||
'Set fd = Application.FileDialog(msoFileDialogFolderPicker)
|
||||
'fd.Show
|
||||
'If fd.SelectedItems.Count = 0 Then Exit Sub
|
||||
With CreateObject("Scripting.FileSystemObject")
|
||||
If Not .FolderExists(filepath) Then .CreateFolder filepath
|
||||
End With
|
||||
Application.DisplayAlerts = True
|
||||
nwb.Activate
|
||||
|
||||
fname = "HC Companies Distributor Price List " & curr & ".xlsx"
|
||||
|
||||
Dim wb As Workbook
|
||||
For Each wb In Workbooks
|
||||
If wb.Name = fname Then
|
||||
If MsgBox("already have a price list open, close it?", vbOKCancel) Then
|
||||
Workbooks(fname).Close
|
||||
Exit For
|
||||
Else
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
Next wb
|
||||
|
||||
If pricelevel.tbPATH.text <> "" Then nwb.SaveAs Filename:=filepath & "\" & fname
|
||||
|
||||
If pricelevel.chPDF Then
|
||||
fname = Replace(fname, "xlsx", "pdf")
|
||||
nwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
|
||||
End If
|
||||
|
||||
If Not pricelevel.chbLEAVEOPEN Then
|
||||
nwb.Close
|
||||
End If
|
||||
'---------------------save full code list---------------------------
|
||||
|
||||
For Each wb In Workbooks
|
||||
If wb.Name = "HC FullCode List.xlsx" Then
|
||||
@ -731,7 +734,7 @@ Sub build_price_level(plev As String)
|
||||
Next wb
|
||||
|
||||
If Not (fcwb Is Nothing) Then
|
||||
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 " & curr & ".xlsx"
|
||||
If pricelevel.chPDF Then
|
||||
fname = Replace(fcwb.Name, "xlsx", "pdf")
|
||||
fcwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
|
||||
|
||||
Loading…
Reference in New Issue
Block a user