SHOW:
|
|
- or go back to the newest paste.
| 1 | Option Explicit | |
| 2 | Dim g_bEventStatus As Boolean | |
| 3 | Dim g_bScreenStatus As Boolean | |
| 4 | Dim g_iCalcStatus As Integer | |
| 5 | ||
| 6 | Sub setPivotFieldType(iFieldType As Integer) | |
| 7 | ' sets the Field Type (sum, average, etc) in a selected range of pivotfields | |
| 8 | ' sanity test | |
| 9 | If TypeName(Selection) <> "Range" Then Exit Sub | |
| 10 | toggleStatus | |
| 11 | On Error Resume Next | |
| 12 | ' test for end of used fields; keeps from running through an entire column or row | |
| 13 | Dim c As Range, ptField As PivotField, intEndRow As Integer, intEndCol As Integer | |
| 14 | intEndRow = Selection.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
| |
| 15 | intEndCol = Selection.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
| |
| 16 | ||
| 17 | ' for each selected cell, get the pivotfield and set it to the field type | |
| 18 | For Each c In Selection | |
| 19 | Set ptField = c.PivotField | |
| 20 | If Not ptField Is Nothing Then _ | |
| 21 | ptField.Function = iFieldType | |
| 22 | If c.Row > intEndRow Or c.Column > intEndCol Then Exit Sub | |
| 23 | Next c | |
| 24 | toggleStatus True | |
| 25 | End Sub | |
| 26 | ||
| 27 | Sub setPivotFieldFormat(strFormat As String) | |
| 28 | ' sets the format of a field (or cell if not a pivot table) according to the strFormat (in NumberFormat style) | |
| 29 | ' sanity test | |
| 30 | If TypeName(Selection) <> "Range" Then Exit Sub | |
| 31 | toggleStatus | |
| 32 | On Error Resume Next | |
| 33 | ' test for end of used fields; keeps from running through an entire column or row | |
| 34 | Dim c As Range, ptField As PivotField, intEndRow As Integer, intEndCol As Integer | |
| 35 | intEndRow = Selection.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
| |
| 36 | intEndCol = Selection.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
| |
| 37 | ||
| 38 | ' for each selected cell, get the pivotfield and set it to the field type | |
| 39 | For Each c In Selection | |
| 40 | Set ptField = c.PivotField | |
| 41 | If ptField Is Nothing Then | |
| 42 | Selection.NumberFormat = strFormat | |
| 43 | Else | |
| 44 | ptField.NumberFormat = strFormat | |
| 45 | End If | |
| 46 | If c.Row > intEndRow Or c.Column > intEndCol Then Exit Sub | |
| 47 | Next c | |
| 48 | toggleStatus True | |
| 49 | End Sub | |
| 50 | ||
| 51 | ' FieldType buttons | |
| 52 | Sub setPivotFieldTypeSum(Optional control As IRibbonControl) | |
| 53 | setPivotFieldType (xlSum) | |
| 54 | End Sub | |
| 55 | Sub setPivotFieldTypeAvg(Optional control As IRibbonControl) | |
| 56 | setPivotFieldType (xlAverage) | |
| 57 | End Sub | |
| 58 | Sub setPivotFieldTypeCnt(Optional control As IRibbonControl) | |
| 59 | setPivotFieldType (xlCount) | |
| 60 | End Sub | |
| 61 | Sub setPivotFieldTypeVar(Optional control As IRibbonControl) | |
| 62 | setPivotFieldType (xlVar) | |
| 63 | End Sub | |
| 64 | Sub setPivotFieldTypeStDev(Optional control As IRibbonControl) | |
| 65 | setPivotFieldType (xlStDev) | |
| 66 | End Sub | |
| 67 | Sub setPivotFieldTypeMax(Optional control As IRibbonControl) | |
| 68 | setPivotFieldType (xlMax) | |
| 69 | End Sub | |
| 70 | Sub setPivotFieldTypeMin(Optional control As IRibbonControl) | |
| 71 | setPivotFieldType (xlMin) | |
| 72 | End Sub | |
| 73 | ||
| 74 | ' Format buttons | |
| 75 | Sub setPivotFieldFormatGen(Optional control As IRibbonControl) | |
| 76 | setPivotFieldFormat ("0")
| |
| 77 | End Sub | |
| 78 | Sub setPivotFieldFormatNum(Optional control As IRibbonControl) | |
| 79 | setPivotFieldFormat ("#,###")
| |
| 80 | End Sub | |
| 81 | Sub setPivotFieldFormatAct(Optional control As IRibbonControl) | |
| 82 | setPivotFieldFormat ("_(* #,##0.0_);_(* (#,##0.0);_(* "" - ""?_);_(@_)")
| |
| 83 | End Sub | |
| 84 | Sub setPivotFieldFormatPct(Optional control As IRibbonControl) | |
| 85 | setPivotFieldFormat ("0.0%")
| |
| 86 | End Sub | |
| 87 | Sub setPivotFieldFormatCur(Optional control As IRibbonControl) | |
| 88 | setPivotFieldFormat ("$0.00;-$0.00")
| |
| 89 | End Sub | |
| 90 | Sub setPivotFieldFormatSci(Optional control As IRibbonControl) | |
| 91 | setPivotFieldFormat ("0000E+00")
| |
| 92 | End Sub | |
| 93 | Sub setPivotFieldFormatBig(Optional control As IRibbonControl) | |
| 94 | setPivotFieldFormat ("0, k")
| |
| 95 | End Sub | |
| 96 | Sub setPivotFieldFormatWho(Optional control As IRibbonControl) | |
| 97 | setPivotFieldFormat ("#,##0")
| |
| 98 | End Sub | |
| 99 | Sub setPivotFieldFormatCustom(Optional control As IRibbonControl) | |
| 100 | If TypeName(Selection) <> "Range" Then Exit Sub | |
| 101 | frm_FieldFormat.Show | |
| 102 | End Sub | |
| 103 | ||
| 104 | Sub toggleStatus(Optional bReset As Boolean = False) | |
| 105 | ' toggles application status between fast and normal | |
| 106 | ' The optional boolean allows a reset to previous state | |
| 107 | On Error Resume Next | |
| 108 | ||
| 109 | Select Case bReset | |
| 110 | Case True | |
| 111 | 'Set application status to previous value or default | |
| 112 | Application.ScreenUpdating = g_bScreenStatus | |
| 113 | Application.EnableEvents = g_bEventStatus | |
| 114 | Application.Calculation = IIf(0 = g_iCalcStatus, xlCalculationAutomatic, g_iCalcStatus) | |
| 115 | Case Else | |
| 116 | 'Save current application status to variables | |
| 117 | g_iCalcStatus = Application.Calculation | |
| 118 | g_bScreenStatus = Application.ScreenUpdating | |
| 119 | g_bEventStatus = Application.EnableEvents | |
| 120 | ||
| 121 | 'Set application status for faster processing | |
| 122 | Application.ScreenUpdating = False | |
| 123 | Application.EnableEvents = False | |
| 124 | Application.Calculation = xlCalculationManual | |
| 125 | End Select | |
| 126 | ||
| 127 | End Sub |
