Nachtrag Laufzeitfehler 13
09.04.2018 09:48:43
Locean
am 28.03. hatte ich euch meinen Laufzeitfehler geschildert und hier um Hilfe gebeten.
Ich habe dazu von Case die Lösung bekommen, welche ich auch direkt eingebaut und ausprobiert habe.
Der Code von Case funktioniert grundsätzlich wunderbar, in den vorgesehenen Feldern brauchen nur Zaghlen eingegeben werden, welche dann automatisch in eine Uhrzeit umgewandelt werden.
Leider funktioniert der Code nur wenn ich in dem dafür vorgesehenen Bereich Zelleinträge vornehme. Sobald ich irgendwo anders auf dem Arbeitsblatt eine Eintragung mache, funktioniert der Code nicht mehr. Es wird mir dann zwar kein Fehler angezeigt, jedoch wird auch kein Doppelpunkt mehr zwischen den Ziffern gesetzt. Ich bin mir ziemlich sicher, es liegt an mir, aber ich weiß leider nicht wo ich den Fehler bereinigen kann.
Ich hoffe ihr könnt mir da nochmal helfen.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin
Application.EnableEvents = False
Application.ScreenUpdating = False
If Target.Address = "$A$2" Then
Range("C5:C35,N5:N35,Y5:Y35,AJ5:AJ35,AU5:AU35,BF5:BF35,BQ5:BQ35,CB5:CB35,CM5:CM35,CX5:CX35,DI5: _
DI35,DT5:DT35,EE5:EE35,EP5:EP35,FA5:FA35,FL5:FL35,FW5:FW35,GH5:GH35,GS5:GS35,HD5:HD35").Select 'hier die Löschbereiche eintragen
Selection.ClearContents
Range("D5:G35,O5:R35,Z5:AC35,AK5:AN35,AV5:AY35,BG5:BJ35,BR5:BU35,CC5:CF35,CN5:CQ35,CY5:DB35,DJ5: _
DM35,DU5:DX35,EF5:EI35,EQ5:ET35,FB5:FE35,FM5:FP35,FX5:GA35,GI5:GL35,GT5:GW35,HE5:HH35").Select 'hier die Löschbereiche eintragen
Selection.ClearContents
Range("I5:I35,T5:T35,AE5:AE35,AP5:AP35,BA5:BA35,BL5:BL35,BW5:BW35,CH5:CH35,CS5:CS35,DD5:DD35, _
DO5:DO35,DZ5:DZ35,EK5:EK35,EV5:EV35,FG5:FG35,FR5:FR35,GC5:GC35,GN5:GN35,GY5:GY35,HJ5:HJ35").Select 'hier die Löschbereiche eintragen
Selection.ClearContents
Range("K5:L35,V5:W35,AG5:AH35,AR5:AS35,BC5:BD35,BN5:BO35,BY5:BZ35,CJ5:CK35,CU5:CV35,DF5:DG35, _
DQ5:DR35,EB5:EC35,EM5:EN35,EX5:EY35,FI5:FJ35,FT5:FU35,GE5:GF35,GP5:GQ35,HA5:HB35,HL5:HM35").Select 'hier die Löschbereiche eintragen
Selection.ClearContents
Range("M5:M35,X5:X35,AI5:AI35,AT5:AT35,BE5:BE35,BP5:BP35,CA5:CA35,CL5:CL35,CW5:CW35,DH5:DH35, _
DS5:DS35,ED5:ED35,EO5:EO35,EZ5:EZ35,FK5:FK35,FV5:FV35,GG5:GG35,GR5:GR35,HC5:HC35,HN5:HN35").Select 'hier die Löschbereiche eintragen
Selection.ClearContents
Range("D5").Select
UrlaubaufDienstplan
End If
If Target.Address = "$A$3" Then
UrlaubaufDienstplan
End If
Sheets("Dienstplan").Unprotect Password:="IsHa"
Dim s%, m%
If Intersect(Target, Range("D5:G35,O5:R35,Z5:AC35,AK5:AN35,AV5:AY35,BG5:BJ35,BR5:BU35,CC5:CF35, _
CN5:CQ35,CY5:DB35,DJ5:DM35,DU5:DX35,EF5:EI35,EQ5:ET35,FB5:FE35,FM5:FP35,FX5:GA35,GI5:GL35,GT5:GW35,HE5:HH35")) Is Nothing Then Exit Sub
With Cells(Target.Row, Target.Column)
If .Value = "" Then Exit Sub
If IsNumeric(.Value) And InStr(.Value, ":") = 0 And _
InStr(.Value, ",") = 0 Then
.NumberFormat = "[hh]:mm"
If Len(.Value) > 2 Then
s = Left(.Value, Len(.Value) - 2)
m = Right(.Value, 2)
Else
s = .Value
m = 0
End If
.Value = s & ":" & m
End If
End With
Fin:
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.description
Sheets("Dienstplan").Protect Password:="IsHa"
Application.ScreenUpdating = True
End Sub
Vielen Dank
Locean