Forums Neueste Beiträge
 

Gruppierungsebenen

15/12/2009 - 17:58 von Karin Wiechern | Report spam
Mit der ShowLevels-Methode des OutLine-Objects:

Worksheets("Sheet1").Outline.ShowLevels columnLevels:=1

kann ich für alle Spalten alle Gruppierungsebenen einklappen.

Wie kann ich, in verschiedenen Spalten, verschiedene Gruppierungsebenen auf-
bzw. zuklappen, bzw. den aktuellen Status dieser Anzeige auslesen ?
(z. B. Spalte 1-3 auf Ebene 2 ausklappen und Spalte 10-13 auf Ebene 3
ausklappen usw.)

MfG
Jochen Wiechern
 

Lesen sie die antworten

#1 Andreas Killer
17/12/2009 - 09:12 | Warnen spam
On 15 Dez., 17:58, "Karin Wiechern"
wrote:

Wie kann ich, in verschiedenen Spalten, verschiedene Gruppierungsebenen auf-
bzw. zuklappen, bzw. den aktuellen Status dieser Anzeige auslesen ?


Jedes Range-Object hat eine OutLineLevel-Eigenschaften die die
Gruppierungsebene der Spalte oder Zeile angibt. Ein wenig irritierend
ist es hierbei das eine Spalte ohne Gruppierung den Level 1 hat.

Schreib mal in A1 die Formel =ZeigeLevel() und ziehe sie nach rechts
und nach unten.

Function ZeigeLevel() As String
Dim R As Range
Set R = Application.Caller
ZeigeLevel = "C" & R.EntireColumn.OutlineLevel - 1 & " R" &
R.EntireRow.OutlineLevel - 1
End Function

Einzelne Gruppierungen auf-/zuklappen geht nicht, die ShowDetail-
Eigenschaft eines Range-Objects klappt nur seine eigene Ebene auf/zu.

Man kann aber das Auf-/Zuklappen nachbilden indem man die Spalten/
Zeilen die mind. diesen OutLineLevel haben ein/ausblendet. Dadurch ist
das gleiche Verhalten zu erreichen als wenn man auf die entsprechenden
Knöpfe der Gliederung klickt.

Andreas.

Sub ShowLevels(Bereich As Range, _
Optional ByVal RowLevels As Integer = 0, _
Optional ByVal ColumnLevels As Integer = 0, _
Optional ByVal HideLevels As Boolean = False)
'Blendet einzelne Gliederungebenen ein/aus

Dim B As Range, A As Range, R As Range
Dim I As Long, J As Long
Dim SaveScreenUpdating As Boolean

SaveScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
On Error GoTo ExitPoint
Set B = Intersect(Bereich, ActiveSheet.UsedRange)
For Each A In B.Areas
For Each R In A
If ColumnLevels > 0 Then
I = R.Column
Do While Columns(I).OutlineLevel > ColumnLevels
I = I - 1
If I < 1 Then Exit Do
Loop
I = I + 1
J = R.Column
Do While Columns(J).OutlineLevel > ColumnLevels
J = J + 1
If J > Columns.Count Then Exit Do
Loop
J = J - 1
If J >= I Then Range(Columns(I), Columns(J)).Hidden = _
HideLevels
End If
If RowLevels > 0 Then
I = R.Row
Do While Rows(I).OutlineLevel > RowLevels
I = I - 1
If I < 1 Then Exit Do
Loop
I = I + 1
J = R.Row
Do While Rows(J).OutlineLevel > RowLevels
J = J + 1
If J > Rows.Count Then Exit Do
Loop
J = J - 1
If J >= I Then Range(Rows(I), Rows(J)).Hidden = _
HideLevels
End If
Next
Next
ExitPoint:
Application.ScreenUpdating = SaveScreenUpdating
End Sub

Ähnliche fragen