AW: Optionsfeld in Zellenwert übertragen
02.06.2017 16:45:06
Franzi
Hallo,
ich habe nun folgende Lösung gewählt:
a) die Haupttabelle enthält eine ActiveX-Checkbox CheckBox1 mit der Frage "Aufgabe erledigt?"
b) Es gibt ein zusätzliches Tabellenblatt mit zwei Spalten: Datum (für die nächsten Monate bis Jahre) und "Aufgabe erledigt?", hinter jedem Datum steht nein.
c) Durch das Anklicken der Checkbox wird in dem zusätzlichen Tabellenblatt das Datum des heutigen Tages aufgesucht und daneben "ja" eingetragen. Abklicken führt zum Gegenteil.
Private Sub CheckBox1_Click()
Dim heutigesdatum As Date
Dim Rng As Range
heutigesdatum = CLng(Date)
' Bei Anklicken der CheckBox1 Eintrag "ja" generieren.
If CheckBox1.Value = True Then
With Sheets("Dokumentation").Range("A:A")
Set Rng = .Find(What:=heutigesdatum, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not Rng Is Nothing Then
Rng.Offset(0, 1).Value = "ja"
Else
MsgBox "Das heutige Datum ist noch nicht in der Dokumentationstabelle aufgeführt."
End If
End With
End If
' Bei Abklicken der CheckBox1 Eintrag "nein" generieren.
If CheckBox1.Value = False Then
With Sheets("Dokumentation").Range("A:A")
Set Rng = .Find(What:=heutigesdatum, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not Rng Is Nothing Then
Rng.Offset(0, 1).Value = "nein"
Else
MsgBox "Das heutige Datum ist noch nicht in der Dokumentationstabelle aufgeführt."
End If
End With
End If
End Sub
d) jeweils beim ersten Öffnen der Datei an einem Tag muss sichergestellt sein, dass der Haken in der Checkbox nicht fälschlicherweise gesetzt ist. Dies macht eine Abfrage unter Workbook_open()
Private Sub Workbook_Open()
Dim heutigesdatum As Date
Dim Rng As Range
heutigesdatum = CLng(Date)
With Sheets("Dokumentation").Range("A:A")
Set Rng = .Find(What:=heutigesdatum, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Rng.Offset(0, 1).Value = "nein" Then
Worksheets("Arbeitsliste").CheckBox1.Value = False
End If
End With
Danke für alle Hilfe!
LG F.