latest forms

PivotShortcut.bas

@@ -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

handler.bas

@@ -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
     

pricelist.frm

@@ -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

targets.bas

@@ -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)