EXCEL: Gruppierungsebenen mit ausdrucken

  • #1
E

EDVler

Bekanntes Mitglied
Themenersteller
Dabei seit
31.08.2004
Beiträge
76
Reaktionspunkte
0
Hi,

Wie kann ich in Excel einstellen, dass der Druckassistent meine Gruppierungsebenen mit ausdruckt?

THX
 
  • #2
Hi EDVler,
was soll Excel den da ausdrucken ? Die Nummern ?
Erklär bitte mal etwas näher, was Du dir da vorstellst.

Gruß Matjes :)
 
  • #3
Ja, es erscheint doch in Excel bei einer Gruppierung die Nr. der Ebene und die dazugehörige Klammer ganz links. Dies will ich mit drucken.
 
  • #4
Hi EDVler,

da gibt es zwei Möglichkeiten:

1. Screenshot - wahrscheinlich nicht gewollt ;D

2. Ein Lösung per Makro, die die Gruppierungsebene zB. in der ersten Spalte darstellt.

Gruß Matjes :)
 
  • #5
Wie sieht so ein Makro aus?
 
  • #6
z.B. so :
Code: 
Sub InSpalteA_Gruppierungsebene()
  
Const c_SP = 1
  Const c_Z_ersteSpalteMitWert = 2
    
  Dim l_rows As Long, z As Long
  
  l_rows = Cells.SpecialCells(xlCellTypeLastCell).Row
  For z = c_Z_ersteSpalteMitWert To l_rows
    Cells(z, c_SP).Value = Rows(z).OutlineLevel
  Next
End Sub

Gruß Matjes :)
 
  • #7
Hi EDVler,

ich hab das Makro noch etwas in Form gegossen. Weiterhin hab ich für die Gliederungsausgabe noch einen Makro geschrieben, der die Gruppierungsebene als Hierarchie der Form 1., 1.1, 1.1.1 ausgibt.

Sub Gruppierungsebene_InSpalteA()
'*******************************************************************
->Das Makro fügt im aktuellen Tabellenblatt vor Spalte A eine Spalte
->ein. In dieser Spalte wird die jeweilige Gruppierungs-Ebene
->der Zeile eingetragen
Zum Vergrößern anklicken....
Sub GroupHierarchie_InSpalteA()
'*******************************************************************
->Im aktuellen Tabellenblatt wird vor Spalte A eine Spalte eingefuegt.
->In dieser Spalte werden die Hierarchen ( Gruppierungs-Ebene)
->in der Form 1.1.1.1.1.1.1 eingetragen
Zum Vergrößern anklicken....

Gruß Matjes :)

Code: 
'*******************************************************************
Sub Gruppierungsebene_InSpalteA()
'*******************************************************************
 ->Das Makro fügt im aktuellen Tabellenblatt vor Spalte A eine Spalte
 ->ein. In dieser Spalte wird die jeweilige Gruppierungs-Ebene
 ->der Zeile eingetragen
'*******************************************************************
 ->0.    aktuelles Blatt auf Typ Tabelle überprüfen
 ->      nein: Meldung und Abbruch
 ->1.    Abfrage der Startzeilennummer
 ->      bei Fehler, Meldung und Abbruch
 ->2.    benutzten Bereich feststellen
 ->2.1   kein benutzter Bereich vorhanden -> Meldung und Abbruch
 ->3.    neue Spalte als Spalte A einfügen
 ->3.1   Spalte als Text formatieren
 ->3.2   Überschrift->Gruppierung' in Zeile 1
 ->      (wenn Start-Zeile > 1)
 ->4     für alle Zeilen des benutzten Bereiches
 ->      Gruppierungsebene in Spalt A eintragen
 ->5.    Spaltenbreite anpassen
 ->6.    Aufräumen
  
  Dim ws As Worksheet
  Dim s_start_row As String, l_start_row As Long
  Dim l_row_last As Long, l_col_last As Long, z As Long
  
  
 ->0.    aktuelles Blatt auf Typ Tabelle überprüfen
 ->      nein: Meldung und Abbruch
  If ActiveSheet.Type <> xlWorksheet Then
    MsgBox (Das aktuelle Blatt ist keine Tabelle :-()
    Exit Sub
  End If
  Set ws = ActiveSheet

 ->1.    Abfrage der Startzeilennummer
 ->      bei Fehler, Meldung und Abbruch
  s_start_row = InputBox( _
    Bitte geben sie die Zeilennummer an, ab der mit & vbLf & _
    der Ausgabe der Gruppierungs-Ebene begonnem werden soll., _
    Eingabe der Startzeile, 2)
    
  If IsNumeric(s_start_row) Then l_start_row = s_start_row
  
  Select Case l_start_row
    Case 1 To 65500
    Case Else
      MsgBox (Der Wert-> & s_start_row &-> ist unzulässig!)
      GoTo Aufraeumen
  End Select

 ->************************************
 ->2.    benutzten Bereich feststellen
 ->2.1   kein benutzter Bereich vorhanden -> Meldung und Abbruch
  If Not BenutztenBereichBestimmen(ws, l_row_last, l_col_last) Then
    MsgBox ( _
    Auf dem Blatt-> & ws.Name & _
   -> ist kein benutzter Bereich vorhanden)
    GoTo Aufraeumen
  End If

 ->************************************
 ->3.    neue Spalte als Spalte A einfügen
  ws.Columns(1).Insert Shift:=xlToRight
 ->3.1   Spalte als Text formatieren
  ws.Columns(1).NumberFormat = @
  ws.Columns(1).HorizontalAlignment = xlCenter

 ->3.2   Überschrift Gruppierungs-Ebene in Zeile 1
 ->      (wenn Start-Zeile > 1)
  If l_start_row > 1 Then
    ws.Cells(1, 1).Value = Gruppierung
    ws.Cells(1, 1).Font.Bold = True
  End If
  
 ->************************************
 ->4     für alle Zeilen des benutzten Bereiches
 ->      Gruppierungsebene in Spalt A eintragen
  For z = l_start_row To l_row_last
    ws.Cells(z, 1).Value = ws.Rows(z).OutlineLevel
  Next
  
 ->************************************
 ->5.    Spaltenbreite anpassen
  ws.Columns(1).AutoFit
  
Aufraeumen:
 ->************************************
 ->6.    Aufräumen
  Set ws = Nothing

End Sub

'*******************************************************************
Sub GroupHierarchie_InSpalteA()
'*******************************************************************
 ->Im aktuellen Tabellenblatt wird vor Spalte A eine Spalte eingefuegt.
 ->In dieser Spalte werden die Hierarchen ( Gruppierungs-Ebene)
 ->in der Form 1.1.1.1.1.1.1 eingetragen
'*******************************************************************
 ->0.    aktuelles Blatt auf Typ Tabelle überprüfen
 ->      nein: Meldung und Abbruch
 ->1.    Sicherheitsabfrage
 ->2.    Abfrage der Startzeilennummer
 ->      bei Fehler, Meldung und Abbruch
 ->3.    benutzten Bereich feststellen
 ->3.1   kein benutzter Bereich vorhanden -> Meldung und Abbruch
 ->4.    neue Spalte als Spalte A einfügen
 ->4.1   Spalte als Text formatieren
 ->4.2   Überschrift->Hierarchie' in Zeile 1
 ->      (wenn Start-Zeile > 1)
 ->5.    Initialisierung der Hirarchie-Variablen
 ->6     für alle Zeilen des benutzten Bereiches
 ->6.1   Hierarchie der Zeile fesstellen
 ->6.2   Hierarchie > letzte Hierarchie
 ->6.2.1 nix machen
 ->6.3   Hierarchie = letzter Hierarchie
 ->6.3.1 Hierarchie-Zähler erhöhen
 ->6.4.  Hierarchie < letzte Hierarchie
 ->6.4.1 Hierarchie-Zähler erhöhen
 ->6.4.2 Hierarchie-Zähler der größeren Hierarchien initialisieren
 ->6.5   Hierarchie ausgeben
 ->7.    Spaltenbreite anpassen
 ->8.    Aufräumen
'*******************************************************************

  Dim wb As Workbook, ws As Worksheet
  Dim s_start_row As String, l_start_row As Long
  Dim l_row_last As Long, l_col_last As Long
  Dim H1 As Integer, H2 As Integer, H3 As Integer, H4 As Integer
  Dim H5 As Integer, H6 As Integer, H7 As Integer, H8 As Integer
  Dim lastH As Integer, aktH As Integer, z As Long, s_H As String
  Const P As String = .
  
  
  If ActiveSheet.Type <> xlWorksheet Then
    MsgBox (Das aktuelle Blatt ist keine Tabelle :-()
    Exit Sub
  End If
  
  Set wb = ActiveWorkbook
  Set ws = ActiveSheet
  
 ->************************************
 ->1.    Sicherheitsabfrage
  If vbNo = MsgBox( _
    Wollen sie in der Mappe  & wb.Name &  auf dem Blatt  & ws.Name & vbLf & _
    eine Spalte vor Spalte A einfügen, und dort die Hierarche ( Gruppierungs-Ebene) & vbLf & _
    in der Form 1.1.1.1.1 ausgeben ?, vbQuestion + vbYesNo) _
  Then GoTo Aufraeumen
  
 ->************************************
 ->2.    Abfrage der Startzeilennummer
 ->      bei Fehler, Meldung und Abbruch
  s_start_row = InputBox( _
    Bitte geben sie die Zeilennummer an, ab der mit & vbLf & _
    der Ausgabe der Hierarchie begonnem werden soll., _
    Eingabe der Startzeile, 2)
    
  If IsNumeric(s_start_row) Then l_start_row = s_start_row
  
  Select Case l_start_row
    Case 1 To 65500
    Case Else
      MsgBox (Der Wert-> & s_start_row &-> ist unzulässig!)
      GoTo Aufraeumen
  End Select

 ->************************************
 ->3.    benutzten Bereich feststellen
 ->3.1   kein benutzter Bereich vorhanden -> Meldung und Abbruch
  If Not BenutztenBereichBestimmen(ws, l_row_last, l_col_last) Then
    MsgBox ( _
    Auf dem Blatt-> & ws.Name & _
   -> ist kein benutzter Bereich vorhanden)
    GoTo Aufraeumen
  End If
  
 ->************************************
 ->4.    neue Spalte als Spalte A einfügen
  ws.Columns(1).Insert Shift:=xlToRight
 ->4.1   Spalte als Text formatieren
  ws.Columns(1).NumberFormat = @
 ->4.2   Überschrift Hierarchie in Zeile 1
 ->      (wenn Start-Zeile > 1)
  If l_start_row > 1 Then
    ws.Cells(1, 1).Value = Hierarchie
    ws.Cells(1, 1).Font.Bold = True
  End If
  
 ->************************************
 ->5.    Initialisierung der Hirarchie-Variablen
  H1 = 0: H2 = 1: H3 = 1: H4 = 1: H5 = 1: H6 = 1: H7 = 1: H8 = 1
 ->letzte erzeugte Hierarchiestufe
  lastH = 1
  
 ->6     für alle Zeilen des benutzten Bereiches
  For z = l_start_row To l_row_last
   ->6.1   Hierarchie der Zeile fesstellen
    aktH = ws.Rows(z).OutlineLevel
    
    If aktH > lastH Then
   ->6.2   Hierarchie > letzte Hierarchie
   ->6.2.1 nix machen
     ->ggf.Anfangsinitialisierung korrigieren
      If H1 = 0 Then H1 = 1
    ElseIf aktH = lastH Then
   ->6.3   Hierarchie = letzter Hierarchie
   ->6.3.1 Hierarchie-Zähler erhöhen
      Select Case aktH
        Case 1: H1 = H1 + 1
        Case 2: H2 = H2 + 1
        Case 3: H3 = H3 + 1
        Case 4: H4 = H4 + 1
        Case 5: H5 = H5 + 1
        Case 6: H6 = H6 + 1
        Case 7: H7 = H7 + 1
        Case 8: H8 = H8 + 1
      End Select
    Else
   ->6.4.  Hierarchie < letzte Hierarchie
   ->6.4.1 Hierarchie-Zähler erhöhen
   ->6.4.2 Hierarchie-Zähler der größeren Hierarchien initialisieren
      Select Case aktH
        Case 1: H1 = H1 + 1
          H2 = 1: H3 = 1: H4 = 1: H5 = 1: H6 = 1: H7 = 1: H8 = 1
        Case 2: H2 = H2 + 1
          H3 = 1: H4 = 1: H5 = 1: H6 = 1: H7 = 1: H8 = 1
        Case 3: H3 = H3 + 1
          H4 = 1: H5 = 1: H6 = 1: H7 = 1: H8 = 1
        Case 4: H4 = H4 + 1
          H5 = 1: H6 = 1: H7 = 1: H8 = 1
        Case 5: H5 = H5 + 1
          H6 = 1: H7 = 1: H8 = 1
        Case 6: H6 = H6 + 1
          H7 = 1: H8 = 1
        Case 7: H7 = H7 + 1
          H8 = 1
      End Select
    End If
    
   ->6.5   Hierarchie ausgeben
    Select Case aktH
      Case 1
        s_H = H1 & P
      Case 2
        s_H = H1 & P & H2 & P
      Case 3
        s_H = H1 & P & H2 & P & H3 & P
      Case 4
        s_H = H1 & P & H2 & P & H3 & P & H4 & P
      Case 5
        s_H = H1 & P & H2 & P & H3 & P & H4 & P & H5 & P
      Case 6
        s_H = H1 & P & H2 & P & H3 & P & H4 & P & H5 & P & H6 & P
      Case 7
        s_H = H1 & P & H2 & P & H3 & P & H4 & P & H5 & P & H6 & P & H7 & P
      Case 8
        s_H = H1 & P & H2 & P & H3 & P & H4 & P & H5 & P & H6 & P & H7 & P & H8 & P
    End Select
    ws.Cells(z, 1).Value = s_H
    lastH = aktH
  Next
  
 ->************************************
 ->7.    Spaltenbreite anpassen
  ws.Columns(1).AutoFit
  
Aufraeumen:
 ->************************************
 ->8.    Aufräumen
  Set ws = Nothing: Set wb = Nothing
  
End Sub
'**************************************************************
Function BenutztenBereichBestimmen(ws As Worksheet, _
                    l_ze As Long, l_spe As Long) As Boolean
  Dim l_max_row As Long, l_max_col As Long, x As Long
  Dim l_cols As Long, l_anz As Long
                              
 ->liefert die letzte beschriebene Spalte/Zeile des Arbeitsblattes
 ->gibt FALSE zurück, wenn das Arbeitsblatt keinen Inhalt hat
  BenutztenBereichBestimmen = True
  
 ->letzte Spalte bestimmen
  l_spe = ws.Cells.SpecialCells(xlCellTypeLastCell).Column
  If l_spe = 0 Then
    BenutztenBereichBestimmen = False: Exit Function
  End If
  For x = l_spe To 1 Step -1
    If (1 < ws.Cells(ws.Rows.Count, x).End(xlUp).Row) Or _
       (ws.Cells(1, x).Value <> ) Then
      l_spe = x: Exit For
    End If
    l_spe = x
  Next
  
 ->letzte Zeile bestimmen
  l_ze = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
  If l_ze = 0 Then
    BenutztenBereichBestimmen = False: Exit Function
  End If
  For x = l_ze To 1 Step -1
    If (1 < ws.Cells(x, ws.Columns.Count).End(xlToLeft).Column) Or _
       (ws.Cells(x, 1).Value <> ) Then
      l_ze = x: Exit For
    End If
    l_ze = x
  Next
 ->Spalte=1, Zeile=1 und leere Zelle -> Blatt leer
  If l_ze = 1 And l_spe = 1 And ws.Cells(1, 1).Value =  Then
    BenutztenBereichBestimmen = False: Exit Function
  End If
  
End Function
 
Thema:

EXCEL: Gruppierungsebenen mit ausdrucken

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums

Themen
113.840
Beiträge
707.963
Mitglieder
51.494
Neuestes Mitglied
Flensburg45
Oben