Zeilenmarkierung

Sub Zeilenmarkierung()
 
' Zeilenmarkierung Makro
' Makro am 09.05.2008 von mwolfgru aufgezeichnet
'
' Tastenkombination: Strg+y
'
'    Range("A5:S5").Select

Dim ActiveCell_Column, ActiveCell_Row, a_CellWeight
Dim aktuelle_Zeile, a_ColorIndex, letzte_Zelle
Dim i, a, c, Zeile
Zeile = 0
c = 0
a_ColorIndex = 0
 
ActiveCell_Column = ActiveCell.Column
ActiveCell_Row = ActiveCell.Row
 
Do While Zeile < 256
'    For i = 0 To 2
'        Range(Cells(ActiveCell_Row + Zeile + i, 1), Cells(ActiveCell_Row + Zeile + i, 256)).Select
'
'            Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
 '   Selection.Borders(xlEdgeBottom).ColorIndex = ActiveCell_Row + Zeile + i
  '     Selection.Borders(xlEdgeBottom).Weight = xlThin

 '       Selection.Borders(xlEdgeBottom).LineStyle = xlNone
  '      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
   '     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    '    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        ' Selection.Borders(xlEdgeTop).LineStyle = xlNone
     '   Selection.Borders(xlEdgeRight).LineStyle = xlNone
      '  Selection.Borders(xlInsideVertical).LineStyle = xlNone
    ' Next
    ' Zeile = Zeile + i
    
    Range(Cells(ActiveCell_Row + Zeile, 1), Cells(ActiveCell_Row + Zeile, 256)).Select
'    Range(Cells(ActiveCell_Row + Zeile, ActiveCell_Column)).Activate

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    ' Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
 
    If (Zeile + 1) / 4 = Int((Zeile + 1) / 4) Then a_ColorIndex = 16
    If (Zeile + 1) / 8 = Int((Zeile + 1) / 8) Then a_ColorIndex = 10
    If (Zeile + 1) / 16 = Int((Zeile + 1) / 16) Then a_ColorIndex = 9
    If (Zeile + 1) / 32 = Int((Zeile + 1) / 32) Then a_ColorIndex = 11
    If (Zeile + 1) / 64 = Int((Zeile + 1) / 64) Then a_ColorIndex = 1
    If (Zeile + 1) / 128 = Int((Zeile + 1) / 128) Then a_ColorIndex = 7
    If (Zeile + 1) / 256 = Int((Zeile + 1) / 256) Then a_ColorIndex = 3
 
 
'    Selection.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
    'aktuelle_Zeile = ActiveCell_Row + Zeile
    
    letzte_Zelle = ActiveCell_Row + Zeile
    a_CellWeight = Cells(ActiveCell_Row + Zeile, ActiveCell_Column).Borders(xlEdgeBottom).Weight
    If a_CellWeight = xlMedium Then
    Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
       Selection.Borders(xlEdgeBottom).Weight = xlMedium
       Selection.Borders(xlEdgeBottom).ColorIndex = 5
       Zeile = 256
       Else
 
       If a_ColorIndex > 0 Then
            Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
            Selection.Borders(xlEdgeBottom).Weight = xlThin
            Selection.Borders(xlEdgeBottom).ColorIndex = a_ColorIndex
        Else
            Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        End If
    End If
    ' Application.CutCopyMode = False
    
    Zeile = Zeile + 1
    c = c + 1
    a_ColorIndex = 0
 
' MsgBox Zeile

' .ColorIndex = 5 = blau
' .ColorIndex = 16 = grau 50%

Loop
 
       Cells(letzte_Zelle + 1, ActiveCell_Column).Activate
 
 
End Sub