SubTotals in Pivot_Interior Color ändern

Hallo Herber Fans,
über folgenden Code kann ich die Subtotals in einer Pivottabelle einblenden:


Sub Subtotals_YES()
Set pvTable = ActiveSheet.PivotTables(1)
For Each pvField In pvTable.RowFields
pvField.Subtotals(1) = True
pvField.Subtotals(1).Interior.ColorIndex = 3
Next pvField
End Sub

Aber wie kann ich diese auch gleich einfärben, um sie besser hervorzuheben? Mit der im Code auskommentierten Zeile: pvField.Subtotals(1).Interior.ColorIndex = 3
hat es nicht funktioniert. Auch mit With/ End With habe ich leider ohne Erfolg schon experimentiert. Im Forum habe ich dazu leider nichts finden können. Auch der Objektkatalog im VBA Editor hat zu Subtotals keine weiteren Befehle aufgelistet, die das realisieren könnten.
Hat jemand von Euch eine Idee?
Vielen Dank!
Gruß, Andreas Hanisch

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andreas,
ich hab nur über einen aufgezeichneten Code einen Weg über eine Selection gefunden. Dirkte ANsparache der Objekte: ?
Ein Fehler der zusätzlich abgefangen werden muss ist die tatsache, das das letzte Zeilenfeld keine Subtotals hat.
Gruß
Franz


Sub Subtotals_YES()
Dim pvTable As PivotTable, pvField As PivotField, strText As String
Set pvTable = ActiveSheet.PivotTables(1)
On Error GoTo Fehler
For Each pvField In pvTable.RowFields
pvField.Subtotals(1) = True
strText = "'" & pvField & "'[All;Total]"
pvTable.PivotSelect strText, xlDataAndLabel, True
Selection.Interior.ColorIndex = 3
ResumeFehler:
Next pvField
Exit Sub
Fehler:
If Err.Number = 1004 Then
'MsgBox "Fehler: " & pvField.Name
Resume ResumeFehler
Else
MsgBox Err.Number & vbLf & Err.Description
End If
End Sub
Sub Subtotals_No()
Dim pvTable As PivotTable, pvField As PivotField, strText As String
Set pvTable = ActiveSheet.PivotTables(1)
On Error GoTo Fehler
For Each pvField In pvTable.RowFields
pvField.Subtotals(1) = True
strText = "'" & pvField & "'[All;Total]"
pvTable.PivotSelect strText, xlDataAndLabel, True
Selection.Interior.ColorIndex = 3
pvField.Subtotals(1) = False
ResumeFehler:
Next pvField
Exit Sub
Fehler:
If Err.Number = 1004 Then
'MsgBox "Fehler: " & pvField.Name
Resume ResumeFehler
Else
MsgBox Err.Number & vbLf & Err.Description
End If
End Sub

Beliebteste Forumthreads (12 Monate)

SubTotals in Pivot_Interior Color ändern

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

SubTotals in Pivot_Interior Color ändern

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread