pt/VBA
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

convert input box on cross joining to range selector

Browse Source
This commit is contained in:
Paul Trowbridge 2021-08-16 09:17:52 -04:00
parent 945863353e
commit 539a966e1c
1 changed files with 4 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

136
FL.bas
View File

@ -45,6 +45,7 @@ Sub Cross_Join_Selection()
Dim d() As String
Dim i As Integer
Dim dest As String
Dim idest As Range
Set r = Selection
@ -59,15 +60,13 @@ Sub Cross_Join_Selection()
i = i + 1
Next ar
dest = InputBox("Input row & column numbers like ""3,17""")
Set idest = Excel.Application.InputBox("select the output cell", , , , , , , 8)
If dest = "" Then
If idest Is Nothing Then
Exit Sub
Else
d = Split(dest, ",")
End If
Call x.SHTp_Dump(r1, Excel.ActiveSheet.Name, CLng(d(0)), CLng(d(1)), False, True)
Call x.SHTp_Dump(r1, Excel.ActiveSheet.Name, idest.row, idest.column, False, True)
End Sub
@ -430,121 +429,6 @@ errh:
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
Sub ColorMatrixExtract()
@ -596,18 +480,6 @@ Sub ColorMatrixExtract()
End Sub
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 LoadChan()