Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

Pivotfeld:Feststellen,ob "ALLE gewählt"+Markierung

Betrifft: Pivotfeld:Feststellen,ob "ALLE gewählt"+Markierung von: Andreas Hanisch
Geschrieben am: 14.05.2008 12:35:00

Hallo Herber Enthusiasten,

ich versuche mich gerade daran, in einer Pivot Tabelle eine Überwachung für die Auswahl von PivotItems in einem PivotTable Field umzusetzen. Ich möchte erreichen, daß der Kopf eines Zeilenfeldes farbig markiert wird (Interior oder dessen Schrift) wenn in diesem Feld NICHT ALLE Pivotitems ausgewählt sind. In großen PivotTabellen ist es mitunter sehr mühselig im Falle einer Indifferenz in den Summen zu eruieren, in welchem Feld nicht alle Elemente markiert sind, die zu dieser Indifferenz führen. Wenn ein solches Feld automatisch farblich markiert ist, wäre das schon eine große Hilfe.
Ebenso wäre es gut, wenn in Anlehnung an einen solchen Code auch festgestellt werden kann, ob die Filterung (die n obersten/ untersten Werte) in der Pivotfeldeigenschaften gewählt sind.
Im Forum habe ich schon viel nach dem Begriff PivotItem gesucht, aber in diesem Threads wurden Codes besprochen, die in alle Pivotitems wieder einblenden. Alle Pivotitems durch zu loopen scheint demnach nicht so günstig für die Performance zu sein.

Ein Idee war über ShowAllItems zu prüfen, aber das haut auch nicht so richtig hin.

Sub Pivot_Zeig_ALLE()
Dim pvItem As PivotItem, pvField As PivotField, pvTable As PivotTable    

Set pvTable = ActiveSheet.PivotTables(1)
Set pvField = pvTable.PivotFields

For Each pvField In pvTable.PivotFields
    If not pvField.ShowAllItems = True Then
    MsgBox "TEST"
    End If
Next pvField

End Sub



Hat jemand von Euch eine Idee, wie ich diese Eigenschaft eines Pivot- Zeilenfeldes („Alle gewählt“) feststellen kann?

Vielen Dank und Grüße

  

Betrifft: AW: Pivotfeld:Feststellen,ob "ALLE gewählt"+Markierung von: fcs
Geschrieben am: 14.05.2008 18:38:46

Hallo Andreas,

hier mal ein Ansatz. Ich weis nicht ob alle Varianten von pivottabellen-Einstellungen abgedeckt werden.
Für seitenfelder und StandardPivotfelder geht es.

Gruß
Franz

Option Explicit

Sub PivotFelder_Checkoballeangezeigt()
  'Prüft die Pivottabelle auf ausgebledete Items und färbt ggf. Labels rot
  Dim objPT As PivotTable, objPF As PivotField, objWks As Worksheet
  Dim bolPageField, bolHidden As Boolean
  Dim objFeld As PivotField
  On Error GoTo Fehler
  Set objWks = ActiveSheet
  Set objPT = objWks.PivotTables(1)
  objPT.RefreshTable
  For Each objPF In objPT.PivotFields
    With objPF
      'If objPT.PageFields.Count > 0 Then
      If objPT.PageFields.Count > 0 Then
        'Prüfen ob Seitenfeld
        bolPageField = False
        For Each objFeld In objPT.PageFields
          bolHidden = False
          If objPF.Name = objFeld.Name Then
            If objPF.DataRange.Value <> "(Alle)" Then
              bolHidden = True
              GoTo Kennzeichnen
            Else
              bolPageField = True
            End If
          End If
        Next
      End If
      If bolPageField = True Then GoTo Kennzeichnen
      If .HiddenItems.Count > 0 Then
        bolHidden = True
      Else
          bolHidden = False
      End If
Kennzeichnen:
      If bolHidden = True Then
        .LabelRange.Interior.ColorIndex = 3 'rot
        MsgBox "Feld  " & .Name & ":  Es ist was ausgeblendet!"
      Else
        .LabelRange.Interior.ColorIndex = 15 'Schaltflächengrau
        MsgBox "Feld  " & .Name & ":  Es ist nichts ausgeblendet!"
      End If
    End With
  Next
  GoTo Beenden
Fehler:
  MsgBox "Fehler Nummer: " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description _
    & vbLf & vbLf & "?"
Beenden:
  Set objPT = Nothing: Set objPF = Nothing: Set objWks = Nothing
End Sub

Sub PivotFelder_LabelFarbe_zuruecksetzen()
  'setz die
  Dim objPT As PivotTable, objPF As PivotField, objWks As Worksheet
  On Error GoTo Fehler
  Set objWks = ActiveSheet
  Set objPT = objWks.PivotTables(1)
  For Each objPF In objPT.PivotFields
    With objPF
        .LabelRange.Interior.ColorIndex = 15 'Schaltflächengrau
    End With
  Next
  GoTo Beenden
Fehler:
Beenden:
  Set objPT = Nothing: Set objPF = Nothing: Set objWks = Nothing
End Sub




  

Betrifft: AW: Pivotfeld:Feststellen,ob "ALLE gewählt"+Markie von: fcs
Geschrieben am: 15.05.2008 12:18:10

Hallo Andreas,

hier eine verbesserte Version. Mein erster Ansatz hatte Probleme mit Feldern, die in der Auswertung nicht verwendet werden.

Gruß
Franz


Sub PivotFelder_Check()
  Dim objPivotTable
  'Alle Pivot-Tabellen im aktiven Blatt prüfen
  For Each objPivotTable In ActiveSheet.PivotTables
    Call PivotFelder_Check_Items(objPT:=objPivotTable, bolMsgAus:=True, bolMsgAlle:=False)
  Next
End Sub

Sub PivotFelder_Check_Items(ByVal objPT As PivotTable, _
    Optional bolMsgAus As Boolean = True, _
    Optional bolMsgAlle = False)
  'Prüft die Felder der Pivottabelle auf ausgebledete Items und färbt ggf. Labels rot
  Dim objPF As PivotField
  Dim intFehler, strMsg As String
  'bolMsgAus: Wenn True dann wird Meldung bei ausgeblendeten Items angezeigt
  'bolMsgAlle:Wenn False dann keine Meldung wenn alle Items angezeigt werden
  On Error GoTo Fehler
  'Spaltenfelder prüfen
  If objPT.ColumnFields.Count > 0 Then
    intFehler = 1
    For Each objPF In objPT.ColumnFields
      With objPF
        Call fncKennzeichnen(objPF, .HiddenItems.Count > 0, _
            bolMsgAus, bolMsgAlle, objPT.Name & vbLf & "Spaltenfeld  ")
      End With
ResumeFehler1:
    Next
  End If
  'Zeilenfelder prüfen
  intFehler = 0
  If objPT.RowFields.Count > 0 Then
    intFehler = 2
    For Each objPF In objPT.RowFields
      With objPF
        Call fncKennzeichnen(objPF, .HiddenItems.Count > 0, _
            bolMsgAus, bolMsgAlle, objPT.Name & vbLf & "Zeilenfeld  ")
      End With
ResumeFehler2:
    Next
  End If
  'Seitenfelder prüfen
  intFehler = 0
  If objPT.PageFields.Count > 0 Then
    intFehler = 3
    For Each objPF In objPT.PageFields
      With objPF
        Call fncKennzeichnen(objPF, .DataRange.Value <> "(Alle)", _
            bolMsgAus, bolMsgAlle, objPT.Name & vbLf & "Seitenfeld  ")
      End With
ResumeFehler3:
    Next
  End If
  GoTo Beenden
Fehler:
  strMsg = "Fehler Nummer: " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
  Select Case intFehler
    Case 1
      strMsg = strMsg & vbLf & vbLf & "Problem Spaltenfeld: " & objPF.Name
      MsgBox strMsg: Resume ResumeFehler1
    Case 2
      strMsg = strMsg & vbLf & vbLf & "Problem Zeilenfeld: " & objPF.Name
      MsgBox strMsg: Resume ResumeFehler2
    Case 3
      strMsg = strMsg & vbLf & vbLf & "Problem Seitenfeld: " & objPF.Name
      MsgBox strMsg: Resume ResumeFehler3
    Case Else
      MsgBox strMsg
  End Select
Beenden:
  Set objPF = Nothing
End Sub

Private Function fncKennzeichnen(objPivotField As PivotField, _
  bolAusgeblendet As Boolean, _
  ByVal bolMsgAus As Boolean, _
  ByVal bolMsgAlle As Boolean, _
  Optional strMsg As String = "Feld  ") As Boolean
  'Kennzeichnung der Ausgeblendeten Pivot-Felder und ggf. Ausgabe einer Meldung
  On Error GoTo Fehler
  With objPivotField
    If bolAusgeblendet = True Then
      .LabelRange.Interior.ColorIndex = 3 'rot
      If bolMsgAus Then MsgBox strMsg & .Name & ":  Es sind Elemente ausgeblendet!"
    Else
      .LabelRange.Interior.ColorIndex = 15 'Schaltflächengrau
      If bolMsgAlle Then MsgBox strMsg & .Name & ":  Alle Elemente werden angezeigt!"
    End If
  End With
  fncKennzeichnen = True
  Exit Function
Fehler:
  MsgBox "Fehler Nummer: " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description _
    & vbLf & vbLf & "Feld: " & objPivotField.Name
  fncKennzeichnen = False
End Function

Sub PivotFelder_LabelFarbe_zuruecksetzen()
  'setz die
  Dim objPT As PivotTable, objPF As PivotField, objWks As Worksheet
  On Error GoTo Fehler
  Set objWks = ActiveSheet
  For Each objPT In objWks.PivotTables
  For Each objPF In objPT.PivotFields
    With objPF
        .LabelRange.Interior.ColorIndex = 15 'Schaltflächengrau
    End With
ResumeFehler:
  Next
  Next
  GoTo Beenden
Fehler:
  Resume ResumeFehler 'Nicht verwendete PivotFelder werden übersprungen
Beenden:
  Set objPT = Nothing: Set objPF = Nothing: Set objWks = Nothing
End Sub




  

Betrifft: AW: Pivotfeld:Feststellen,ob "ALLE gewählt"+Markie von: Andreas Hanisch
Geschrieben am: 16.05.2008 14:52:07

Hallo Franz,

entschuldige bitte die späte Antwort.

Wow! Vielen Dank für diesen Code. Ich habe ihn in ein erstes Beispiel kopiert und dort laufen lassen. Funktioniert einwandfrei. Ich werde nun noch einen tieferen Blick auf die Codezeilen werfen.

Dankeschön.

Grüße, Andreas


  

Betrifft: AW: Pivotfeld:Feststellen,ob "ALLE gewählt"+Markie von: fcs
Geschrieben am: 17.05.2008 20:24:28

Hallo Andreas,

der Code ist so konzipiert, dass er nicht unbedingt in die Arbeitsmappe eingebaut werden muss, in der sich die Pivottabelle befindet.

Du kannst ihn auch in deine persönlicheMakroarbeitsmappe übernehmen und dann jede Pivot im gerade aktiven Blatt prüfen. Zum Starten des Makros kann man einen Button in einer Symbolleiste einrichten oder auch einen Menüpunkt ergänzen.

Gruß
Franz