pivot table shortcuts

This commit is contained in:
Paul Trowbridge 2022-12-20 10:13:26 -05:00
parent 87f42ff5fd
commit 9fb5ad9c93

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