AW: Farbwechsel für 10 Sekunden
12.02.2008 18:30:00
Werner
Hier der Code, kann heute nicht mehr antworten, muß zum Dienst, DANKE!!
Option Explicit
Private Sub Image1_Click()
Range("G2").Select
End Sub
' Makro zum Zurückspringen ins EingACefeld nach ENTER
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$G$3" Then Range("G2").Select
If Target.Address = "$G$1" Then Range("G2").Select
If Target.Address = "$F$2" Then Range("G2").Select
If Target.Address = "$H$2" Then Range("G2").Select
End Sub
' Makro zum Übertragen der eingegebenen Zahlen in die Permanenzliste
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte, s As Byte, _
check As Boolean
If Target.Address "$G$2" Then Exit Sub
Application.EnableEvents = False
If Application.IsNumber(Target.Value) = False Then
GoTo ErrorHandler
End If
Select Case Target.Value
Case 4, 6, 7, 8, 9
With Range("G2")
.Value = ""
.Select
End With
Case 0
Range("AC4:AC22").Value = Range("AC5:AC23").Value
Range("AC23").ClearContents
Call DBKminus
With Range("G2")
.Value = ""
.Select
End With
Case 999
Call Anzeigelöschen
Case 1, 2, 3, 5
Range("AC5:AC23").Value = Range("AC4:AC22").Value
Range("AC4") = Target.Value
Call DBKplus
With Range("G2")
.Value = ""
.Select
End With
Case Else
With Range("G2")
.Value = ""
.Select
End With
End Select
Application.EnableEvents = True
Dim merk As String
If Target.Address = "$AC$4" Then
merk = Range("F4").Interior.ColorIndex
If Target = 1 Then
Range("F4").Interior.ColorIndex = 4
Application.Wait Now + TimeSerial(0, 0, 10)
Range("F4").Interior.ColorIndex = merk
Else
If Target = "" Then
Range("F4").Interior.ColorIndex = merk
End If
End If
End If
ErrorHandler:
With Range("G2")
.Value = ""
.Select
End With
End Sub