Gruppierungen mit VBA ansprechen

Forumthread: Gruppierungen mit VBA ansprechen

18.04.2017 16:41:23

darko

Hallo Excelisten
In meine Tabelle habe ich Gruppierungen erstellt.
3 Ebene (Zeilen)
Aktuell habe ich ca 100 Zeilen und Liste wird Zukünftig bestimmt noch wachsen.
Frage:
Wie Kann ich die angelegte Gruppierungen bei jedem neuem Mappe Start per VBA alle öffnen und dass Excel anschliessend automatisch in die Zelle A2 springt?
Habt ihr eine Idee?
Gruss
darko

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Gruppierungen mit VBA ansprechen

18.04.2017 17:09:36

Michael

Hallo!
Der folgende Code ermittelt die höchste Zeilen(!)-Gliederungsstufe im verwendeten Zell-Bereich des angegebenen Blattes (hier "Tabelle1") und erweitert anschließend die Zeilen-Gruppierung auf diesem Blatt auf dem entsprechenden Level. Danach wird Zelle A2 auf diesem Blatt angesteuert.

Sub ExpandOutline()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim i&, outLvl&
With Ws
For i = 1 To .UsedRange.Rows.Count
If .Rows(i).OutlineLevel > outLvl Then outLvl = .Rows(i).OutlineLevel
Next i
.Outline.ShowLevels rowlevels:=outLvl
Application.Goto .Range("A2")
End With
End Sub

Wenn Du das beim Öffnen der Mappe ausführen willst, kannst Du noch in das Modul der Arbeitsmappe folgenden Code einfügen:

Private Sub Workbook_Open()
ExpandOutline
End Sub

Kommst Du damit zurecht?
LG
Michael

AW: ...oder noch erweitert...

18.04.2017 17:30:31

Michael

...ließe sich hier auch noch differenzierteres bauen:

Sub ExpandOutline(Typ$, Optional ZellSprung$)
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.ActiveSheet
Dim i&, j&, RoutLvl&, CoutLvl&
With Ws
With .UsedRange
For i = 1 To .Rows.Count
If .Rows(i).OutlineLevel > RoutLvl Then RoutLvl = .Rows(i).OutlineLevel
Next i
For j = 1 To .Columns.Count
If .Columns(j).OutlineLevel > CoutLvl Then CoutLvl = .Columns(i).OutlineLevel
Next j
End With
Select Case Typ
Case Is = "Zeilen"
.Outline.ShowLevels rowlevels:=RoutLvl
Case Is = "Spalten"
.Outline.ShowLevels columnlevels:=CoutLvl + 1
Case Is = "Alles"
.Outline.ShowLevels rowlevels:=RoutLvl, columnlevels:=CoutLvl + 1
End Select
If ZellSprung  "" Then Application.Goto .Range(ZellSprung)
End With
Set Wb = Nothing
Set Ws = Nothing
End Sub
Sub TesteEs()
Call ExpandOutline("Alles", "B4")
End Sub

LG
Michael

AW: ...oder noch erweitert...

18.04.2017 18:01:17

darko

Hallo Michael
vielen danke für deine Unterstützung.
Beide Varianten habe ich bei mir ausprobiert aber hat sich nicht verändert.
Was mache ich falsch, wo muss ich die Codes einfügen etc.
Danke und Gruss
darko

AW: ...oder noch erweitert...

18.04.2017 18:14:14

darko

Hallo Michael
in Zwischenzeit funktioniertes Teilweise, verknüpft mit einem Button.
Was noch nicht ok ist, das beim öffnen von der Mappe nicht automatisch funktioniert.
Weil ich möchte jedes Mal beim öffnen der Mappe, dass diese zwei Schritten automatisch ausgeführt werden:
-alle Gruppierungen aufmachen
-Excel springt automatisch in die Zelle A2
Gruss
darko

AW: ...oder noch erweitert...

19.04.2017 09:53:39

Michael

Hallo!
Ich hatte gestern keine Zeit mehr. Vergiss mal den zweiten Code, das war wohl etwas zu viel bei Deinen aktuellen Kenntnissen, damit das ganze läuft, wenn Du die Mappe öffnest, gehe wie folgt vor:
Öffne mit Alt+F11 den VBA-Editor, Du siehst links eine Art Explorer-Ansicht. Klicke doppelt auf "DieseArbeitsmappe" und füge dann den folgenden Code dort ein

Private Sub Workbook_Open()
Dim Ws As Worksheet: Set Ws = Me.Worksheets("Tabelle1")
Dim i&, RoutLvl&
Dim j&, CoutLvl&
With Ws
For i = 1 To .UsedRange.Rows.Count
If .Rows(i).OutlineLevel > RoutLvl Then RoutLvl = .Rows(i).OutlineLevel
Next i
.Outline.ShowLevels rowlevels:=RoutLvl
For j = 1 To .UsedRange.Columns.Count
If .Columns(j).OutlineLevel > CoutLvl Then CoutLvl = .Columns(j).OutlineLevel
Next j
.Outline.ShowLevels columnlevels:=CoutLvl
Application.Goto .Range("A2"), True
End With
End Sub

Du musst nur den Blattnamen der Tabelle anpassen, auf der die Gliederungen vorhanden sind (aktuell "Tabelle1"), und ggf. die Zelle auf die "gesprungen" werden soll (aktuell A2). So wie oben geschrieben öffnet Dir der Code sowohl Zeilen als auch Spalten-Gliederungen.
Passt?
LG
Michael

AW: ...oder noch erweitert...

19.04.2017 11:40:59

darko

Hallo Michael
ich habe in Zwischenzeit so gelöst:
in Diese Arbeitsmappe beiden Codes eingefügt
Sub ExpandOutline()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim i&, outLvl&
With Ws
For i = 1 To .UsedRange.Rows.Count
If .Rows(i).OutlineLevel > outLvl Then outLvl = .Rows(i).OutlineLevel
Next i
.Outline.ShowLevels rowlevels:=outLvl
Application.Goto .Range("A6")
End With
End Sub
Hier habe ich mit dem Befehl Call geschafft beim öffnen der Mappe
die Prozedur automatisch zu starten.

Private Sub Workbook_Open()
Call ExpandOutline
End Sub

Jetzt funktioniert problemlos.
Vielen Dank für die tolle Unterstützung + Gruss
darko

AW: Gern, Danke für die Rückmeldung, owT

19.04.2017 13:08:28

Michael

Beliebteste Forumthreads (12 Monate)

Forumthread: Gruppierungen mit VBA ansprechen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Gruppierungen mit VBA ansprechen

Forumthread: Gruppierungen mit VBA ansprechen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread