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)
|
effdate = CDate(pricelevel.tbEddDate.text)
|
||||||
filepath = pricelevel.tbPATH & "\" & plev
|
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
|
If pricelevel.chbFULLCODE Then
|
||||||
'---------------------get full code list--------------------------------------------------------------------
|
'---------------------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")
|
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
|
Application.PrintCommunication = True
|
||||||
End If
|
End If
|
||||||
|
|
||||||
'Application.ScreenUpdating = True
|
|
||||||
'Exit Sub
|
|
||||||
|
|
||||||
'---------------------create new workbook-------------------------------------------------------------------
|
'---------------------save full code list---------------------------
|
||||||
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
|
|
||||||
|
|
||||||
For Each wb In Workbooks
|
For Each wb In Workbooks
|
||||||
If wb.Name = "HC FullCode List.xlsx" Then
|
If wb.Name = "HC FullCode List.xlsx" Then
|
||||||
@ -731,7 +734,7 @@ Sub build_price_level(plev As String)
|
|||||||
Next wb
|
Next wb
|
||||||
|
|
||||||
If Not (fcwb Is Nothing) Then
|
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
|
If pricelevel.chPDF Then
|
||||||
fname = Replace(fcwb.Name, "xlsx", "pdf")
|
fname = Replace(fcwb.Name, "xlsx", "pdf")
|
||||||
fcwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
|
fcwb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filepath & "\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user