bräuchte mal wieder Hilfe von Euch Experten.
Habe im Upload alles beschrieben.(hoffe ich)
https://www.herber.de/bbs/user/80643.xls
Danke schon mal
Gruß
Josef
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target(1, 1), [C28:C34,E43:E44]) Is Nothing Then
With Target(1, 1)
If Int(Cells(28, "H")) > 1 And Int(Cells(28, "H"))
.Font.Name = "Wingdings"
.Font.Size = 15
.Value = IIf(.Value = Chr(168), Chr(254), Chr(168))
End If
End With
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target(1, 1), [H28]) Is Nothing Then
If Target = "" Then Range("C28:C32").Value = Chr(168)
End If
If Not Intersect(Target(1, 1), [F43,F44]) Is Nothing Then
If Target "" Then
Target.Offset(, -1) = Chr(254)
Else
Target.Offset(, -1) = Chr(168)
End If
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target(1, 1), [C28:C34,E43:E44]) Is Nothing Then
With Target(1, 1)
If Int(Cells(28, "H")) >= 1 And Int(Cells(28, "H"))
Gruß MatthiasOption Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Wenn nicht gemeinsamer Bereich zwischen Ziel und C28:C34 ist nichts dann
If Not Intersect(Target, Range("C28:C34")) Is Nothing Then
'Wenn Ganzzahl H28 = H28 und H28 > 0 und H28 < 22 dann
If Int(Range("H28").Value) = Range("H28").Value And _
Range("H28").Value > 0 And _
Range("H28").Value < 22 Then
'Zielwert = wenn Zeichen 168 dann Zeichen 254 (Haken) sonst Zeichen 168
Target.Value = IIf(Target.Value = Chr(168), Chr(254), Chr(168))
'oder
Else
'Zielwert = Zeichen 168
Target.Value = Chr(168)
'Ende Wenn Ganzzahl H28 = H28 und H28 > 0 und H28 < 22 dann
End If
'Bearbeitung abbrechen
Cancel = True
'Ende Wenn nicht gemeinsamer Bereich zwischen Klick und C28:C34 ist nichts dann
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Wenn nicht gemeinsamer Bereich zwischen Ziel und F43:F44 ist nichts dann
If Not Intersect(Target, Range("F43:F44")) Is Nothing Then
'Wenn Typname F43 Text und Typname F44 Text dann
If TypeName(Range("F43").Value) = "String" And TypeName(Range("F44").Value) = "String" Then
'Checkboxwert = 254 (Haken)
Range("E43") = Chr(254)
Range("E44") = Chr(254)
'oder
Else
'Checkboxwert = 168
Range("E43") = Chr(168)
Range("E44") = Chr(168)
'Wenn Typname F43 Text und Typname F44 Text dann
End If
End If
'Ende Wenn nicht gemeinsamer Bereich zwischen Ziel und F43:F44 ist nichts dann
End Sub
[size=8]Code eingefügt mit [url=http://vbahtml.origo.ethz.ch] VBA in HTML 2.3[/url][/size]