Thema: Tastensperre | Herbers Excel-Forum

Hallo Excelianer
Gibt es eine Möglichkeit wenn z.B. eine der 4 Richtungstasten öfter als zwei Mal infolge betätigt wurden, ein Makro in (Workbook_SheetSelectionChange) nicht od. nicht mehr ausgeführt wird?.
Hat vielleicht jemand nen TIPP?.
Danke im voraus & Grüße
Lorenz

Hi
probier mal das Makro.
dein eigenes SelectionChange-Makro musst du and der bezeichneten Stelle einbauen:

Option Explicit
Dim Sel1 As Range
Dim Sel2 As Range
Dim Sel3 As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Check As Boolean
Dim i As Long
Dim CheckR As Boolean
Dim CheckC As Boolean
Dim R(3) As Long, C(3) As Long
If Target.Cells.Count > 1 Then
ElseIf Sel1 Is Nothing Then
ElseIf Sel2 Is Nothing Then
ElseIf Sel3 Is Nothing Then
Else
R(0) = ActiveCell.Row: C(0) = ActiveCell.Column
R(1) = Sel1.Row: C(1) = Sel1.Column
R(2) = Sel2.Row: C(2) = Sel2.Column
R(3) = Sel3.Row: C(3) = Sel3.Column
If (Abs(R(0) - R(3)) = 3 And Abs(R(0) - R(2)) = 2 And Abs(R(0) - R(1)) = 1 _
And C(0) = C(1) And C(0) = C(2) And C(0) = C(3)) Or _
(Abs(C(0) - C(3)) = 3 And Abs(C(0) - C(2)) = 2 And Abs(C(0) - C(1)) = 1 _
And R(0) = R(1) And R(0) = R(2) And R(0) = R(3)) Then
Check = True
End If
End If
If Not Check Then
MsgBox "Hier sollte jetzt dein Makro stehen"
End If
Set Sel3 = Sel2
Set Sel2 = Sel1
Set Sel1 = ActiveCell
End Sub

Gruß, Daniel

Hallo Daniel.
Vielen Dank. Dein Makro funktioniert "1A" . Aber in Kombination mit meinem Code leider nicht.
hier der Code:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If InStr(1, "1.2.3.4.5.6.7.8.9.10.11.12.13.14.15.16.17.18.19.20.21.22.23.24.25.26.27.28.29.30. _
31.", Sh.Name) <> 0 Then
If Target.Row >= 6 And Target.Row <= 89 And Target.Column = 37 Then frmZA.Show
If wksDaten.Range("z5").Value = 1 Then
If Target.Cells.Count > 1 Then
ElseIf Sel1 Is Nothing Then
ElseIf Sel2 Is Nothing Then
ElseIf Sel3 Is Nothing Then
Else
R(0) = ActiveCell.Row: C(0) = ActiveCell.Column
R(1) = Sel1.Row: C(1) = Sel1.Column
R(2) = Sel2.Row: C(2) = Sel2.Column
R(3) = Sel3.Row: C(3) = Sel3.Column
If (Abs(R(0) - R(3)) = 3 And Abs(R(0) - R(2)) = 2 And Abs(R(0) - R(1)) = 1 And C(0) = C(1)  _
And C(0) = C(2) And C(0) = C(3)) Or _
(Abs(C(0) - C(3)) = 3 And Abs(C(0) - C(2)) = 2 And Abs(C(0) - C(1)) = 1 And R(0) = R(1)  _
And R(0) = R(2) And R(0) = R(3)) Then
Check = True
End If
End If
If Not Check Then
With ActiveSheet.TxtInfo
If Not Intersect(Target, Range("A6:A89")) Is Nothing Then
Select Case wksDaten.Cells(Target.Row, 30)
Case Is = "C5"
sArtVerwend = " - Obermeister"
Case Is = "C3", "C4"
sArtVerwend = " - Meister"
Case Is = "AO"
sArtVerwend = " - Aufsichtsorgan"
Case Is = "SM"
sArtVerwend = " - selbstständiger Monteur"
Case Is = "Ptf"
sArtVerwend = " - Partieführer"
Case Is = "FA"
sArtVerwend = " - Facharbeiter"
Case Is = "FaH"
sArtVerwend = " - Facharbeiter-Helfer"
Case Is = "AA"
sArtVerwend = " - angelernter Arbeiter"
Case Is = "KV"
sArtVerwend = " - Kollektivvertragler"
Case Is = "Mau"
sArtVerwend = " - Maurer"
Case Is = "Pfl"
sArtVerwend = " - Pflasterer"
Case Is = "Zimm"
sArtVerwend = " - Zimmerer"
Case Is = "Schreiber"
sArtVerwend = " - Kanzleischreiber"
Case Is = "Mau"
sArtVerwend = " - Maurer"
End Select
.Height = 27.5
.AutoSize = True
.Visible = True
.Top = Target.Offset(2, 0).Top
.Left = Target.Left
If Target.Value = "" Then .Visible = False
If Target <> "" Then
.Text = wksDaten.Cells(Target.Row, 29) & "     Schema " & wksDaten.Cells(Target. _
Row, 32) & "/" & wksDaten.Cells(Target.Row, 31) & sArtVerwend
End If
Else
.Visible = False
.Top = Cells(5, 5).Top
.Left = Cells(5, 5).Left
End If
End With
With ActiveSheet.TxtName
If Not Intersect(Target, Range("B6:BD89")) Is Nothing Then
.Height = 27.5
.AutoSize = True
.Visible = True
.Top = Target.Offset(2, 0).Top
.Left = Target.Left
If Target = "" Then
.Text = UCase(wksDaten.Cells(Target.Row, 27)) & " - [" & Cells(5, Target.Column).Text & "]"
.BackColor = &H4000&
End If
If Target <> "" Then
.Text = UCase(Cells(Target.Row, 1)) & " " & wksT32.Cells(99, Target.Column) & " " &  _
Target.Text & " " & wksT32.Cells(100, Target.Column)
.BackColor = &H80&
End If
Else
.Visible = False
.Top = Cells(5, 10).Top
.Left = Cells(5, 10).Left
End If
End With
With ActiveSheet.TxtStatist
If Not Intersect(Target, Union(Range("BE6:CZ89"), Range("EW6:FL89"), Range("GR6:HW89"))) Is  _
Nothing Then
.Height = 27.5
.AutoSize = True
If Target.Value = "" Then
.Visible = False
Else
.Visible = True
End If
.Top = Target.Offset(2, 0).Top
.Left = Target.Left
If Target <> "" Then
.Text = UCase(wksDaten.Cells(Target.Row, 27)) & " bei " & wksT1.Cells(90, Target.Column) _
& " " & Target.Text & " " & Cells(5, Target.Column).Text
.BackColor = &H80&
End If
Else
.Visible = False
.Top = Cells(5, 15).Top
.Left = Cells(5, 15).Left
End If
End With
End If
End If
End If
Set Sel3 = Sel2
Set Sel2 = Sel1
Set Sel1 = ActiveCell
End Sub

Kannst du vielleicht erkennen woran es scheitert?
PS.: Die Txt.... sind Textboxen in den Sheets!
Grüße Lorenz

HI
da müsste ich schon die Datei haben um das zu testen.
setz mal am anfang des Makros einen Haltepunkt und ge im Einzelstepmodus durch.
vielleicht erkennst du dann, wo das Problem ist.
Gruß, Daniel