Thema: Beispiele zum Einsatz des SelectionChange-Ereignisses

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

Beiträge aus dem Excel-Forum zu den Themen Ereignis und SelectionChange