AW: Tastensperre
06.01.2010 15:05:43
Lorenz
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 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