meine codes funktionieren einfach nicht mehr!
13.12.2018 16:02:44
merc
und der profi bin ich jetzt eigentlich auch nicht
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("F32:I37,F39:I43,F45:I50,F52:I61,F63:I66,F68:I75,F77:I79,F81:I83,F85: _
I86,F104:I104")) Is Nothing Then Exit Sub
Cancel = True
Target = IIf(Target = "X", "", "X")
If Target = "X" And (Target.Column = 8 Or Target.Column = 9) Then
MsgBox ("Bitte Bemerkung eintragen")
End If
End Sub
Private Sub Worksheet_Doublick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("F32:I37,F39:I43,F45:I50,F52:I61,F63:I66,F68:I75,F77:I79,F81:I83,F85: _
I86,F104:I104")) Is Nothing Then Exit Sub
Target = IIf(Target = "X", "", "X")
Cancel = True
End Sub
Sub CheckifNull()
Dim x As Integer
For x = 32 To 104
If Range(Cells(x, 6), Cells(x, 6)).Value = 0 Then
Range(Cells(x, 6), Cells(x, 6)).Select
Selection.EntireRow.Hidden = True
End If
Next x
End Sub Sub AlleAusgeblendetenZeilenAnzeigen()
Dim r As Variant
For Each r In ActiveSheet.UsedRange.Rows
If r.Hidden = True Then r.Hidden = False
Next r
End Sub Sub Löschebereich()
Range("F32:I37,F39:I43,F45:I50,F52:I61,F63:I66,F68:I75,F77:I79,F81:I83,F85:I86,F104:I104").ClearContents
End Sub