AW: Pivot sortieren (fcs Code)
28.05.2014 22:41:31
fcs
Hallo Marc,
hier die Anpassung mit Wahl der Sortierrichtung in einer MsgBox.
Falls "Abbrechen" nicht möglich sein soll, dann den Paramer "Buttons" ändern von vbYesNoCancel in vbYesNO.
Gruß
Franz
Sub SortierePivot()
Dim SortierRef As Range
Dim SortierRefField As String
Dim pvField As PivotField, pvTable As PivotTable
Dim bolSortiert As Boolean, intFehler As Integer, strMsg As String
Dim varSortorder
On Error GoTo Fehler
Auswaehlen:
intFehler = 1
Set SortierRef = Application.InputBox("Bitte Sortierreferenz markieren:" & vbLf & _
"Abbrechen verläßt die Sortierung.", "Sortierreferenz", Type:=8)
Application.ScreenUpdating = False
Application.EnableEvents = False
If SortierRef Is Nothing Then
Exit Sub
Else
intFehler = 2
SortierRefField = SortierRef.PivotField
varSortorder = MsgBox("Sortierrichtung des Feldes aufsteigend?" & vbLf _
& "(Ja = aufsteigend, Nein =absteigend)", _
Buttons:=vbYesNoCancel + vbQuestion, _
Title:="Sortierfeld: " & SortierRefField)
Select Case varSortorder
Case vbYes
varSortorder = xlAscending
Case vbNo
varSortorder = xlDescending
Case vbCancel
Exit Sub
End Select
intFehler = 3
Set pvTable = ActiveSheet.PivotTables(1)
For Each pvField In pvTable.RowFields
intFehler = 4
Select Case pvField.Name
Case "Werte" ', "Data", "Values" 'mehrere Datenfelder in Zeilenbeschriftungen - _
sprachenabhängig
' MsgBox "Feld " & pvField.Name ,,"Makro: SortierePivot'Testzeile
Case Else
pvField.AutoSort varSortorder, SortierRefField
End Select
Next
bolSortiert = True
intFehler = 0
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
If bolSortiert = True Then
MsgBox ("PivotTabelle ist sortiert")
End If
Exit Sub
Fehler:
strMsg = "Fehler " & Err.Number & " ist aufgetreten!" & vbLf & Err.Description
Select Case intFehler
Case 1 'Keine Zelle selektiert
MsgBox strMsg & vbLf & vbLf & "Fehler bei Selektion, keine Zelle selektiert!"
Case 2 'Zelle außerhalb der Pivot-Tabelle selektiert
If MsgBox(strMsg & vbLf & vbLf & SortierRef.Value _
& ": Zelle außerhalb der PivotTabelle wurde selektiert" _
& vbLf & vbLf & "Sortierreferenz neu markieren?", vbYesNo) = vbYes Then
Application.ScreenUpdating = True
Resume Auswaehlen
End If
Case 3
MsgBox strMsg & vbLf & vbLf & "Pivottabelle fehlt"
Case 4 'Unzulässiges Feld in Pivot-Tabelle selectiert
If MsgBox(strMsg & vbLf & vbLf & "Feldzuweisung bei Sortierung fehlerhaft" _
& vbLf & vbLf & "Sortierreferenz neu markieren?", vbYesNo) = vbYes Then
Application.ScreenUpdating = True
Resume Auswaehlen
End If
Case Else
MsgBox strMsg
End Select
End Sub