AW: Automatisch zur nächsten Zelle springen (ohne
22.02.2004 21:17:21
Reinhard
Hi Thomas,
probiers mal mit nachfolgendem Code.
Leider klappte die Parameterübergabe an "check(x as Integer)" nicht, wie zB so:
Application.OnKey "0", "check(""0"")" o.ä.
Gruß
Reinhard
Sub Ein()
Application.OnKey "0", "check0"
Application.OnKey "1", "check1"
Application.OnKey "2", "check2"
Application.OnKey "3", "check3"
Application.OnKey "4", "check4"
Application.OnKey "5", "check5"
Application.OnKey "6", "check6"
Application.OnKey "7", "check7"
Application.OnKey "8", "check8"
Application.OnKey "9", "check9"
End Sub
Sub Aus()
Application.OnKey "0"
Application.OnKey "1"
Application.OnKey "2"
Application.OnKey "3"
Application.OnKey "4"
Application.OnKey "5"
Application.OnKey "6"
Application.OnKey "7"
Application.OnKey "8"
Application.OnKey "9"
End Sub
Sub check0()
x = 0
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check1()
x = 1
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check2()
x = 2
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check3()
x = 3
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check4()
x = 4
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check5()
x = 5
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check6()
x = 6
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check7()
x = 7
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check8()
x = 8
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub
Sub check9()
x = 9
If ActiveCell.Row > 1 Then
Select Case ActiveCell.Column
Case 1
ActiveCell.Value = x
ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 1 Then ActiveCell.Select
Case 2
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 4 Then ActiveCell.Offset(0, 1).Select
If Len(ActiveCell.Value) > 4 Then ActiveCell.Select
Case 3
ActiveCell.Value = ActiveCell.Value * 10 + x
If Len(ActiveCell.Value) = 6 Then ActiveCell.Offset(1, -2).Select
If Len(ActiveCell.Value) > 6 Then ActiveCell.Select
Case Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End Select
Else
ActiveCell.Value = ActiveCell.Value * 10 + x
End If
End Sub