add shortcut keys and pricelist csv

This commit is contained in:
Trowbridge 2020-01-10 14:17:16 -05:00
parent 07d66cc754
commit 94bc6e2b14

75
FL.bas
View File

@ -1,3 +1,4 @@
Attribute VB_Name = "FL"
Option Explicit Option Explicit
Public price_sheet As Worksheet Public price_sheet As Worksheet
@ -374,6 +375,7 @@ Sub json_from_table()
End Sub End Sub
Sub PastValues() Sub PastValues()
Attribute PastValues.VB_ProcData.VB_Invoke_Func = "V\n14"
On Error GoTo errh On Error GoTo errh
@ -385,6 +387,7 @@ errh:
End Sub End Sub
Sub CollapsePvtItem() Sub CollapsePvtItem()
Attribute CollapsePvtItem.VB_ProcData.VB_Invoke_Func = "Z\n14"
On Error GoTo show_det On Error GoTo show_det
ActiveCell.PivotItem.DrilledDown = False ActiveCell.PivotItem.DrilledDown = False
@ -412,6 +415,7 @@ errh:
End Sub End Sub
Sub ExpandPvtItem() Sub ExpandPvtItem()
Attribute ExpandPvtItem.VB_ProcData.VB_Invoke_Func = "X\n14"
On Error GoTo show_det On Error GoTo show_det
ActiveCell.PivotItem.DrilledDown = True ActiveCell.PivotItem.DrilledDown = True
@ -439,6 +443,7 @@ errh:
End Sub End Sub
Sub CollapsePvtFld() Sub CollapsePvtFld()
Attribute CollapsePvtFld.VB_ProcData.VB_Invoke_Func = "A\n14"
On Error GoTo show_det On Error GoTo show_det
ActiveCell.PivotField.DrilledDown = False ActiveCell.PivotField.DrilledDown = False
@ -467,6 +472,7 @@ errh:
End Sub End Sub
Sub ExpandPvtFld() Sub ExpandPvtFld()
Attribute ExpandPvtFld.VB_ProcData.VB_Invoke_Func = "S\n14"
On Error GoTo show_det On Error GoTo show_det
ActiveCell.PivotField.DrilledDown = True ActiveCell.PivotField.DrilledDown = True
@ -612,6 +618,7 @@ Sub auto_fit_range()
End Sub End Sub
Sub pivot_field_format() Sub pivot_field_format()
Attribute pivot_field_format.VB_ProcData.VB_Invoke_Func = "F\n14"
ActiveSheet.PivotTables(1).PivotFields(ActiveCell.value).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)" ActiveSheet.PivotTables(1).PivotFields(ActiveCell.value).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
@ -925,3 +932,71 @@ Sub go_to_price_issue()
End Sub End Sub
Sub build_price_upload()
Dim x As New TheBigOne
Dim pl() As String
Dim i As Long
Dim j As Long
Dim ul() As String
Dim pl_code As String
Dim pl_action As String
Dim pl_d1 As String
Dim pl_d2 As String
Dim pl_d3 As String
Dim fd As FileDialog
pl = x.SHTp_GetString(Selection)
ReDim ul(10, UBound(pl, 2))
PRICELIST_SHOW:
pricelist.Show
pl_code = pricelist.tbCODE.Text
pl_d1 = pricelist.tbD1.Text
pl_d2 = pricelist.tbD2.Text
pl_d3 = pricelist.tbD3.Text
pl_action = "2"
If Len(pricelist.tbCODE) > 5 Then
MsgBox ("price code must be 5 or less characters")
GoTo PRICELIST_SHOW
End If
ul(0, 0) = "HDR"
ul(1, 0) = pl_action
ul(2, 0) = pl_code
ul(3, 0) = Left(pl_d1, 30)
ul(4, 0) = Left(pl_d2, 30)
ul(5, 0) = Left(pl_d3, 30)
ul(6, 0) = "Y"
ul(7, 0) = "N"
j = 1
For i = LBound(pl, 2) + 1 To UBound(pl, 2)
ul(0, j) = "DTL"
ul(1, j) = pl_code
ul(2, j) = pl(7, i)
ul(3, j) = pl(5, i)
ul(4, j) = pl(4, i)
ul(5, j) = pl(6, i)
ul(10, j) = "2"
j = j + 1
Next i
'--------Open file-------------
If Not x.FILEp_CreateCSV(pricelist.tbPATH.Text & "\" & pl_code & ".csv", ul) Then
MsgBox ("error")
End If
Excel.Workbooks.Open (pricelist.tbPATH.Text & "\" & pl_code & ".csv")
'---------------------header row---------------------------------
End Sub