Hallo,
ich habe hier einen Code der soweit eigentlich funktioniert, aber sobald ich einen der Set RaBereich (hervorgehoben mit Fettschrift) auskommentiere, funktioniert der Code nicht.
Ich benötige aber alle aufgeführten Bereiche. Kann man das vielleicht irgenwie anders lösen ?
Was kann ich tun ? Wer kann helfen ?
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim RaBereich As Range
If CallByName(Selection, IIf(Val( _
Application.Version) > 11, "CountLarge", "Count"), VbGet) = 1 Then
<strong>Set RaBereich = Union(Range("J:J"), Range("L:L"), Range("N:N"), Range("P:P"), Range("R:R"), Range("T:T"), Range("W:W"), Range("Y:Y"), Range("AA:AA"), Range("AC:AC"), Range("AE:AE"), Range("AG:AG"), Range("AI:AI"), Range("AK:AK"), Range("AM:AM"), Range("AO:AO"))
If Not Intersect(Target, RaBereich) Is Nothing Then
ActiveSheet.Unprotect Password:="skill"
If IsDate(ActiveCell) Then
frm_Kalender.Tag = ActiveCell
ElseIf InStr(ActiveCell, "/") > 0 Then
DaDatumUe = DateSerial(Mid(ActiveCell, InStr(ActiveCell, "/") + 1), 1, 1) _
+ Left(ActiveCell, InStr(ActiveCell, "/") - 1) * 7 _
- Weekday(DateSerial(Mid(ActiveCell, InStr(ActiveCell, "/") + 1), 1, 1), 2)
If Weekday(DateSerial(Mid(ActiveCell, InStr(ActiveCell, "/") + 1), 1, 1), 2) > 4 Then
DaDatumUe = DaDatumUe + 1
Else
DaDatumUe = DaDatumUe - 6
End If
frm_Kalender.Tag = DaDatumUe
ElseIf ActiveCell = "" Then
If IsDate(Range("K1")) Then
frm_Kalender.Tag = Range("K1")
Else
frm_Kalender.Tag = Date
End If
End If
frm_Kalender.Show
SendKeys "{ESC}", True
End If
Set RaBereich = Nothing
End If
Exit Sub
End Sub