简体   繁体   中英

Pivot Table with Conditional Formatting: Where did my indents go?

This question is a follow-on to my previous question, asked and answered previously. (The code, with a three line modification and reposted here, is taken directly from that post in its entirety.)

After successfully getting my pivot table conditionally formatted, my users have noticed that any of the typical row indentations (for additional row fields) are missing. So when I have several fields selected as Rows, I see this:

在此处输入图片说明

Instead of this:

在此处输入图片说明

Missing the indentation makes it hard to read.

There are several things I've tried, including

  1. Via PivotTable Options, setting "When in compact form indent row labels: 4 characters"
  2. Setting this same value using VBA, as in:

    '--- restore the indentation levels (because all the formatting above wiped it out) staffingTable.CompactRowIndent = 4

  3. And attempting to preserve the pivot table formatting:

    staffingTable.PreserveFormatting = True

None of which achieve the desired indentation format.

I've included the code below in its entirety and would appreciate any insights to make this work if possible.

Option Explicit

Sub ColorizeData()
    Dim staffingTable As PivotTable
    Dim data As Range
    Set staffingTable = ActiveSheet.PivotTables(PIVOT_TABLE_NAME)
    Set data = staffingTable.DataBodyRange
    '--- don't select the bottom TOTALS row, we don't want it colored
    Set data = data.Resize(data.rows.count - 1)

    '--- ALWAYS clear all the conditional formatting before adding
    '    or changing it. otherwise you end up with lots of repeated
    '    formats and conflicting rules
    ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.FormatConditions.Delete
    ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.ClearFormats
    staffingTable.DataBodyRange.Cells.NumberFormat = "#0.00"
    staffingTable.ColumnRange.NumberFormat = "mmm-yyyy"

    '--- the cell linked to the checkbox on the pivot sheet is
    '    supposed to be covered (and hidden) by the checkbox itself
    If Not ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Range("D2") Then
        '--- we've already cleared it, so we're done
        Exit Sub
    End If

    '--- capture the active cell so we can re-select it after we're done
    Dim previouslySelected As Range
    Set previouslySelected = ActiveCell

    '--- colorizing will be based on the type of data being shown
    '    many times there will be multiple data sets shown as sums in
    '    the data area. the conditional formatting by FTEs only makes
    '    sense if we colorize the Resource or TaskName fields
    '    most of the other fields will be shown as summary lines
    '    (subtotals) so those will just get a simple and consistent
    '    color scheme

    Dim field As PivotField
    For Each field In staffingTable.PivotFields
        Select Case field.Caption
        Case "Project"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeDataRange Selection, RGB(47, 117, 181), RGB(255, 255, 255)
                End If
            End If
        Case "WorkCenter"
            If field.Orientation = xlRowField Then
                If field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeDataRange Selection, RGB(155, 194, 230), RGB(0, 0, 0)
                End If
            End If
        Case "Resource", "TaskName"
            If field.Orientation = xlRowField Then
                If (field.Position = 2) And PivotItemsShown(staffingTable.PivotFields("Project")) Then
                    staffingTable.PivotSelect field.Caption, xlDataOnly, True
                    ColorizeConditionally Selection
                ElseIf field.Position = 1 Then
                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
                    ColorizeConditionally Selection
                End If
            End If
            '        Case "TaskName"
            '            If field.Orientation = xlRowField Then
            '                If field.Position = 1 Then
            '                    staffingTable.PivotSelect field.Caption, xlFirstRow, True
            '                Else
            '                    staffingTable.PivotSelect field.Caption, xlDataOnly, True
            '                End If
            '                ColorizeConditionally Selection
            '            End If
        End Select
    Next field

    '--- restore the indentation levels (because all the formatting above wiped it out)
    staffingTable.CompactRowIndent = 4
    staffingTable.PreserveFormatting = True

    '--- re-select the original cell so it looks the same as before
    previouslySelected.Select
End Sub

Private Sub ColorizeDataRange(ByRef data As Range, _
                              ByRef interiorColor As Variant, _
                              ByRef fontColor As Variant)
    data.interior.color = interiorColor
    data.Font.color = fontColor
End Sub

Private Sub ColorizeConditionally(ByRef data As Range)
    '--- light green for part time FTEs
    Dim dataCondition As FormatCondition
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=0.1", _
                                                  Formula2:="=0.5")
    With dataCondition
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.ThemeColor = xlThemeColorAccent6
        .interior.TintAndShade = 0.799981688894314
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- solid green for full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=0.51", _
                                                  Formula2:="=1.2")
    With dataCondition
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = 0
        .Font.color = RGB(0, 0, 0)
        .interior.PatternColorIndex = xlAutomatic
        .interior.color = 5296274
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- orange for slightly over full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlBetween, _
                                                  Formula1:="=1.2", _
                                                  Formula2:="=1.85")
    With dataCondition
        .Font.color = RGB(0, 0, 0)
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.color = RGB(255, 192, 0)
        .SetFirstPriority
        .StopIfTrue = False
    End With

    '--- red for way over full time FTEs
    Set dataCondition = data.FormatConditions.Add(Type:=xlCellValue, _
                                                  Operator:=xlGreater, _
                                                  Formula1:="=1.85")
    With dataCondition
        .Font.color = RGB(255, 255, 255)
        .Font.TintAndShade = 0
        .interior.PatternColorIndex = xlAutomatic
        .interior.color = RGB(255, 0, 0)
        .SetFirstPriority
        .StopIfTrue = False
    End With
End Sub

I don't entirely know why this happens, but it looks like when you clear the formatting on the worksheet, it is removing the indentation, but it is leaving the table in compact form. It seems that if you change the format of the table to something else and then change it back to compact form, it will fix the indentation.

Add these lines somewhere after you clear the formats in the worksheet:

ThisWorkbook.Sheets(PIVOT_SHEET_NAME).Cells.ClearFormats
staffingTable.RowAxisLayout xlTabularRow
staffingTable.RowAxisLayout xlCompactRow    

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM