Timer mit Selection-change absichern
14.02.2009 11:26:00
Franz
bastle an einem Video-Archiv wo ich in einem Blatt SEQUENZEN 10 Timerwerte bzw. Startwerte von Filmabschnitten verwalte. Diese Startwerte nutzt das Mediaplayer-Steuerelement unter currentposition.
Der folgende Code läuft schon ganz gut (ursprünglich aus dem Archiv und ergänzt). Kann man ihn aber noch etwas tunen?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vWert As String
Dim h As Integer, m As Integer, s As Integer, nozero As Integer
'Eingabe-Beispiel: 062345 oder 62345, es folgt als Timerwert: 06:23:45
'2.Beispiel: 34 ergibt als Timerwert: 00:00:34
'If Target.Column 6 Then Exit Sub
If IsEmpty(Target) Or Selection.Cells.Count > 1 Then Exit Sub
'vWert = CStr(Target.Value)
vWert = Target.Value
If Not IsNumeric(vWert) Then
Target.Value = ""
ActiveCell.ClearContents
Exit Sub
End If
On Error GoTo ERRORHANDLER 'man weiss ja nie!
Select Case Len(vWert)
Case 1: vWert = "00:00:0" & vWert
Case 2: vWert = "00:00:" & vWert
Case 3: vWert = "00:0" & Left(vWert, 1) & ":" & Right(vWert, 2)
Case 4: vWert = "00:" & Left(vWert, 2) & ":" & Right(vWert, 2)
Case 5: vWert = "0" & Left(vWert, 1) & ":" & Mid(vWert, 2, 2) & ":" & Right(vWert, 2)
Case 6: vWert = Left(vWert, 2) & ":" & Mid(vWert, 3, 2) & ":" & Right(vWert, 2)
Case Is > 6
Target.Value = ""
ActiveCell.ClearContents
Exit Sub
End Select
h = Left(vWert, 2): m = Mid(vWert, 4, 2): s = Right(vWert, 2)
If h 24 Then
Target.Value = ""
ActiveCell.ClearContents
Exit Sub
End If
If m 60 Then
Target.Value = ""
ActiveCell.ClearContents
Exit Sub
End If
If s 60 Then
Target.Value = ""
ActiveCell.ClearContents
Exit Sub
End If
nozero = h + m + s
If nozero = 0 Then
Target.Value = ""
ActiveCell.ClearContents
Exit Sub
End If
Application.EnableEvents = False
Target.Value = vWert
Application.EnableEvents = True
Exit Sub
ERRORHANDLER:
ActiveCell.ClearContents
Application.EnableEvents = True
End Sub
Was meint der Profi? Bin nur Hobby-Programmierer.
Tschüss!
Franz D.