Gruppe
Ereignis
Problem
In 15 Tabellenblättern werden Beispiele zum Einsatz des SelectionChange-Ereignisses gezeigt.
ClassModule: Tabelle1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Range("B5:C10")
If Intersect(Target.Cells(1), rng) Is Nothing Or _
Intersect(Target.Cells(Target.Cells.Count), rng) _
Is Nothing Then rng.Select
End Sub
ClassModule: Tabelle2
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Range("B1,B3,B5,B7")
If Selection.Cells.Count > 1 Then ActiveCell.Select
If Intersect(ActiveCell, rng) Is Nothing Then _
rng.Cells(1).Select
End Sub
ClassModule: Tabelle3
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Cells.Count > 1 Then ActiveCell.Select
End Sub
ClassModule: Tabelle4
Private Sub Worksheet_Activate()
gvCmt = Application.DisplayCommentIndicator
Application.DisplayCommentIndicator = xlCommentAndIndicator
End Sub
Private Sub Worksheet_Deactivate()
Application.DisplayCommentIndicator = gvCmt
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cmt As Comment
If Target.Cells.Count > 1 Then ActiveCell.Select
For Each cmt In Comments
cmt.Delete
Next cmt
If Target.HasFormula Then
Set cmt = Target.AddComment(Target.FormulaLocal)
cmt.Shape.TextFrame.AutoSize = True
End If
End Sub
StandardModule: Modul1
Public gvCmt As Variant
Public grngOld As Range
Public gdblRowHeight As Double
Public gintSize As Integer
Sub MacroOut()
MsgBox "Sie waren soeben in Zelle D6!"
End Sub
Sub MacroIn()
MsgBox "Sie befinden sich in Zelle D6!"
End Sub
ClassModule: Tabelle5
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Animation1
If Target.Address = "$E$4" Then
.Visible = True
.Open ThisWorkbook.Path & "\ykohl.avi"
Else
.Visible = False
End If
End With
End Sub
ClassModule: Tabelle6
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With TextBoxes(1)
.Top = Target.Top
.Left = Target.Left
.Text = Target.Address(False, False)
End With
End Sub
ClassModule: Tabelle7
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlColorIndexNone
Target.Interior.ColorIndex = 6
End Sub
ClassModule: Tabelle8
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells(WorksheetFunction.CountA(Columns(1)) + 1, 1).Value = _
Target.Address(False, False)
End Sub
ClassModule: Tabelle9
Dim bln As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim rng As Range
Set rng = Range("D6")
If Target.Address = rng.Address Then bln = True
If bln = True And Target.Address <> rng.Address Then
Call MacroOut
bln = False
End If
End Sub
ClassModule: Tabelle10
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$D$6" Then Call MacroIn
End Sub
ClassModule: Tabelle11
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.EnableEvents = False
Range(Target, Target.Offset(0, 9)).Select
Application.EnableEvents = True
End Sub
ClassModule: Tabelle12
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error Resume Next
grngOld.Font.Size = gintSize
Rows(grngOld.Row).RowHeight = gdblRowHeight
gintSize = Target.Font.Size
gdblRowHeight = Rows(Target.Row).RowHeight
If IsEmpty(Target) Then Exit Sub
Target.Font.Size = 20
Set grngOld = Target
Rows(Target.Row).AutoFit
End Sub
ClassModule: Tabelle13
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column > 3 And Target.Column < 7 Then
Application.Cursor = xlWait
Else
Application.Cursor = xlDefault
End If
End Sub
ClassModule: Tabelle14
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strList
If Target.Column <> 1 Then Exit Sub
If Range("B1").Value <> "Monate" And _
Range("B1").Value <> "Tage" Then Exit Sub
Select Case Range("B1").Value
Case "Monate"
strList = "Monate"
Case "Tage"
strList = "Tage"
End Select
With Target.Validation
.Delete
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:="=" & strList
End With
End Sub
ClassModule: Tabelle15
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$7" Then Range("A15").Select
End Sub