Zellen markieren

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) intFarbe = 40 intFarbe2 = 22 ' zuweisen von variablennamen intAktiveSpalte = ActiveCell.Column intAktiveZeile = ActiveCell.Row ' zurücksetzen Cells.Interior.ColorIndex = xlNone Cells.Font.Bold = False For tmpSpalte = 1 To intAktiveSpalte Cells(intAktiveZeile, tmpSpalte).Interior.ColorIndex = intFarbe Next For tmpZeile = 1 To intAktiveZeile Cells(tmpZeile, intAktiveSpalte).Interior.ColorIndex = intFarbe Next Cells(ActiveCell.Row, ActiveCell.Column).Interior.ColorIndex = intFarbe2 End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
geht nur mit einer zusammenhängenden Markierung.
im Tabellenmodul

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then
Application.OnKey "{Tab}", "prctab"
Application.OnKey "~", "prcenter"
Application.OnKey "{enter}", "prcenter"
Application.OnKey "+{Tab}", "prcshifttab"
Else
Application.OnKey "{Tab}"
Application.OnKey "~"
Application.OnKey "{enter}"
Application.OnKey "+{Tab}"
End If
FaerbMich
End Sub

in ein Modul

Option Explicit
Sub prcTab()
Dim iFirstR As Long, iLastR As Long, iFirstC As Long, iLastC As Long
With Selection
iFirstC = .Column
iLastC = .Column + .Columns.Count - 1
iFirstR = .Row
iLastR = .Row + .Rows.Count - 1
End With
Select Case ActiveCell.Column
Case iFirstC To iLastC - 1
ActiveCell.Offset(, 1).Activate
Case iLastC
Select Case ActiveCell.Row
Case iFirstR To iLastR - 1
ActiveCell.Offset(1, -iLastC + iFirstC).Activate
Case iLastR
ActiveCell.Offset(-iLastR + iFirstR, -iLastC + iFirstC).Activate
End Select
End Select
FaerbMich
End Sub
Sub prcEnter()
Dim iFirstR As Long, iLastR As Long, iFirstC As Long, iLastC As Long
With Selection
iFirstC = .Column
iLastC = .Column + .Columns.Count - 1
iFirstR = .Row
iLastR = .Row + .Rows.Count - 1
End With
Select Case ActiveCell.Row
Case iFirstR To iLastR - 1
ActiveCell.Offset(1).Activate
Case iLastR
Select Case ActiveCell.Column
Case iFirstC To iLastC - 1
ActiveCell.Offset(-iLastR + iFirstR, 1).Activate
Case iLastC
ActiveCell.Offset(-iLastR + iFirstR, -iLastC + iFirstC).Activate
End Select
End Select
FaerbMich
End Sub
Sub prcShiftTab()
Dim iFirstR As Long, iLastR As Long, iFirstC As Long, iLastC As Long
With Selection
iFirstC = .Column
iLastC = .Column + .Columns.Count - 1
iFirstR = .Row
iLastR = .Row + .Rows.Count - 1
End With
Select Case ActiveCell.Column
Case iFirstC + 1 To iLastC
ActiveCell.Offset(, -1).Activate
Case iFirstC
Select Case ActiveCell.Row
Case iFirstR + 1 To iLastR
ActiveCell.Offset(-1).Activate
Case iFirstR
ActiveCell.Offset(iLastR - iFirstR, iLastC - iFirstC).Activate
End Select
End Select
FaerbMich
End Sub
Sub FaerbMich()
Const F1 = 40
Const F2 = 22
With Cells
.Interior.ColorIndex = xlNone
.Font.Bold = False
End With
With Range(Cells(ActiveCell.Row, 1), ActiveCell)
.Interior.ColorIndex = F1
.Font.Bold = True
End With
ActiveCell.Interior.ColorIndex = F2
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread