Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1552to1556
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Gruppierungen mit VBA ansprechen

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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
AW: Gern, Danke für die Rückmeldung, owT
19.04.2017 13:08:28
Michael

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige