Compare commits

...

4 Commits

Author SHA1 Message Date
220116c67d latest forms 2022-12-20 10:13:36 -05:00
9fb5ad9c93 pivot table shortcuts 2022-12-20 10:13:26 -05:00
87f42ff5fd update ports 2022-12-20 10:13:08 -05:00
2d5e32b123 unknown 2022-12-20 10:12:38 -05:00
7 changed files with 144 additions and 7 deletions

131
PivotShortcut.bas Normal file
View File

@ -0,0 +1,131 @@
Attribute VB_Name = "PivotShortcut"
Option Explicit
Sub SetPivotShortcutKeys()
Call Application.MacroOptions("PERSONAL.xlsb!CollapsePvtFld", "", , , , "A")
Call Application.MacroOptions("PERSONAL.xlsb!CollapsePvtItem", "", , , , "Z")
Call Application.MacroOptions("PERSONAL.xlsb!ExpandPvtFld", "", , , , "S")
Call Application.MacroOptions("PERSONAL.xlsb!ExpandPvtItem", "", , , , "X")
Call Application.MacroOptions("PERSONAL.xlsb!PastValues", "", , , , "V")
Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format", "", , , , "F")
Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_3dec", "", , , , "N")
Call Application.MacroOptions("PERSONAL.xlsb!pivot_field_format_1dec", "", , , , "M")
End Sub
Sub CollapsePvtItem()
Attribute CollapsePvtItem.VB_ProcData.VB_Invoke_Func = "Z\n14"
On Error GoTo show_det
ActiveCell.PivotItem.DrilledDown = False
On Error GoTo drill_down
ActiveCell.PivotItem.ShowDetail = False
show_det:
If Err.Number <> 0 Then
On Error GoTo errh
ActiveCell.PivotItem.ShowDetail = False
Err.Number = 0
End If
drill_down:
If Err.Number <> 0 Then
On Error GoTo errh
ActiveCell.PivotItem.DrilledDown = False
End If
errh:
End Sub
Sub ExpandPvtItem()
Attribute ExpandPvtItem.VB_ProcData.VB_Invoke_Func = "X\n14"
On Error GoTo show_det
ActiveCell.PivotItem.DrilledDown = True
On Error GoTo drill_down
ActiveCell.PivotItem.ShowDetail = True
show_det:
If Err.Number <> 0 Then
On Error GoTo errh
ActiveCell.PivotItem.ShowDetail = True
Err.Number = 0
End If
drill_down:
On Error GoTo errh
If Err.Number <> 0 Then
On Error GoTo errh
ActiveCell.PivotItem.DrilledDown = True
End If
errh:
End Sub
Sub CollapsePvtFld()
Attribute CollapsePvtFld.VB_ProcData.VB_Invoke_Func = "A\n14"
On Error GoTo show_det
ActiveCell.PivotField.DrilledDown = False
On Error GoTo drill_down
ActiveCell.PivotField.ShowDetail = False
show_det:
If Err.Number <> 0 Then
On Error GoTo errh
ActiveCell.PivotField.ShowDetail = False
Err.Number = 0
End If
drill_down:
On Error GoTo errh
If Err.Number <> 0 Then
On Error GoTo errh
ActiveCell.PivotField.DrilledDown = False
End If
errh:
End Sub
Sub ExpandPvtFld()
Attribute ExpandPvtFld.VB_ProcData.VB_Invoke_Func = "S\n14"
On Error GoTo show_det
ActiveCell.PivotField.DrilledDown = True
On Error GoTo drill_down
ActiveCell.PivotField.ShowDetail = True
show_det:
If Err.Number <> 0 Then
On Error GoTo errh
ActiveCell.PivotField.ShowDetail = True
Err.Number = 0
End If
drill_down:
If Err.Number <> 0 Then
On Error GoTo errh
ActiveCell.PivotField.DrilledDown = True
End If
errh:
End Sub

View File

@ -242,12 +242,18 @@ Function request_adjust(doc As String, ByRef fail As Boolean) As Object
fail = True
Exit Function
End If
If Mid(wr, 1, 6) = "null" Then
MsgBox ("API route not implemented")
fail = True
Exit Function
End If
Set json = JsonConverter.ParseJson(wr)
If IsNull(json("x")) Then
MsgBox ("no adjustment was made")
fail = True
fail = False
Exit Function
End If

BIN
login.frx

Binary file not shown.

Binary file not shown.

View File

@ -31,7 +31,7 @@ End Sub
Private Sub bOK_Click()
If tbPath = "" Then
If tbPATH = "" Then
MsgBox ("no directory specified")
Exit Sub
End If
@ -49,7 +49,7 @@ Private Sub bPICK_Click()
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Show
tbPath.text = fd.SelectedItems(1)
tbPATH.text = fd.SelectedItems(1)
End Sub

Binary file not shown.

View File

@ -15,12 +15,12 @@ Sub get_options()
'If Not x.ADOp_OpenCon(0, PostgreSQLODBC, "usmidlnx01", False, "ptrowbridge", "qqqx53!030", "Port=5030;Database=ubm") Then Exit Sub
sql = "SELECT * FROM rlarp.get_options('" & mold & "');"
res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm")
res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidlnx01", False, "report", "report", "Port=5432;Database=ubm")
ws.Range("M1:P350").ClearContents
Call x.SHTp_Dump(res, ws.Name, 1, 13, False, True, 15)
sql = "SELECT * FROM rlarp.get_option_costs('" & mold & "');"
res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidlnx01", False, "report", "", "Port=5030;Database=ubm")
res = x.ADOp_SelectS(0, sql, True, 100, True, PostgreSQLODBC, "usmidlnx01", False, "report", "report", "Port=5432;Database=ubm")
ws.Range("C1:K350").ClearContents
Call x.SHTp_Dump(res, ws.Name, 1, 3, False, True, 8)
@ -97,7 +97,7 @@ Sub save_targets()
sqlt = sqlt & sql(0, i) & vbCrLf
Next i
targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 18, True), True, True, PostgreSQL, False, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 18, True), True, True, PostgreSQL, False, True, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
sqlt = Replace(sqlt, "replace_this", targt)
@ -113,7 +113,7 @@ Sub save_targets()
sqlt = sqlt & sql(0, i) & vbCrLf
Next i
targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 18, True), True, True, PostgreSQL, False, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
targt = x.SQLp_build_sql_values(x.SHTp_Get(ws.Name, 1, 18, True), True, True, PostgreSQL, False, True, "N", "N", "S", "S", "S", "S", "S", "S", "N", "N", "N", "N", "N")
sqlt = Replace(sqlt, "replace_this", targt)