08.05.2017, 08:49
Guten Morgen Excel Fans,
Ich komm am Montag Morgen gleich mal zur Sache.
Ich habe eine Excel Tabelle in der viele Daten stehen. Diese Daten werden in einer UserForm ausgelesen. Name und Vorname in
einer Listbox eingelesen und sortiert nach Nachname.
Bei klick auf einen Nachname werden wir die Personenbezogenen Daten angezeigt.
Da es sich um eine Tabelle handelt in der Untersuchungsdaten gespeichert werden laufen diese Daten auch ab. Jede TextBox ( 20 Stück ) füllt sich mit den Daten aus der Tabelle die zum Nachnamen passen.
Zum Problem:
Ich plane die nächsten Untersuchungstermin und möchte in die TextBox "nächster_Termin" per OptionButton die Hintergrundfarbe der TextBox ändern. Rot für Nächster Termin nötig, Gelb für Geplant und Grün für alle ok. Es reicht das nur die TextBox "nächster_Termin" die Farbe ändern die dazugehörige Zelle ist egal.
Ich komm am Montag Morgen gleich mal zur Sache.
Ich habe eine Excel Tabelle in der viele Daten stehen. Diese Daten werden in einer UserForm ausgelesen. Name und Vorname in
einer Listbox eingelesen und sortiert nach Nachname.
Bei klick auf einen Nachname werden wir die Personenbezogenen Daten angezeigt.
Da es sich um eine Tabelle handelt in der Untersuchungsdaten gespeichert werden laufen diese Daten auch ab. Jede TextBox ( 20 Stück ) füllt sich mit den Daten aus der Tabelle die zum Nachnamen passen.
Zum Problem:
Ich plane die nächsten Untersuchungstermin und möchte in die TextBox "nächster_Termin" per OptionButton die Hintergrundfarbe der TextBox ändern. Rot für Nächster Termin nötig, Gelb für Geplant und Grün für alle ok. Es reicht das nur die TextBox "nächster_Termin" die Farbe ändern die dazugehörige Zelle ist egal.
Code:
Private Sub checkbox_G20_Change()
End Sub
Private Sub checkbox_G20_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G24_Change()
End Sub
Private Sub checkbox_G24_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G25_Change()
End Sub
Private Sub checkbox_G25_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G26_2_Change()
End Sub
Private Sub checkbox_G26_2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G26_Change()
End Sub
Private Sub checkbox_G26_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G29_Change()
End Sub
Private Sub checkbox_G29_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G31_Change()
End Sub
Private Sub checkbox_G31_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G33_Change()
End Sub
Private Sub checkbox_G33_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G37_Change()
End Sub
Private Sub checkbox_G37_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_G41_Change()
End Sub
Private Sub checkbox_G41_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
Private Sub checkbox_txtG46_Change()
End Sub
Private Sub checkbox_G46_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Chr(KeyAscii) Like "[ü]" = False Then KeyAscii = 0
End Sub
----------------------------------------------------------------------------------------------
'Neuer Eintrag Schaltfläche Ereignisroutine
Private Sub Neuer_EintragButton_Click()
Dim lZeile As Long
'Wenn der Benutzer einen neuen Eintrag erzeugen möchte,
'erstellen wir einen neuen Eintrag in der ListBox und markieren
'diesen, damit der Benutzer die Daten eintragen kann
lZeile = 7 'Start in Zeile 2, Zeile 1 sind ja die überschriftrn
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
'Nach Durchlauf dieser Schleife steht lZeile in der ersten leeren Zeile von Tabelle1
'Neuen Eintrag in die Tabelle1 schreiben, Spalte ID muss gefüllt sein, damit
'unsere Routinen die Zeile wiederfinden!
Tabelle1.Cells(lZeile, 2) = CStr("Neuer Eintrag Zeile" & lZeile)
'Und neuen Eintrag in die UserForm eintragen
ListBox1.AddItem CStr("Neuer Eintrag Zeile" & lZeile)
'Den neuen Eintrag markieren mit Hilfe des ListIndexes
ListBox1.ListIndex = ListBox1.ListCount - 1
'Durch das Click Ereignis der ListBox werden die Daten automatisch geladen
End Sub
----------------------------------------------------------------------------------------------
'Löschen Schaltfläche Ereignisroutine
Private Sub löschen_Button_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 7 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht
Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete
'Die ListBox muss nun neu geladen werden!
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
----------------------------------------------------------------------------------------------
'Speichern Schaltfläche Ereignisroutine
Private Sub Speicher_Button_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Wir müssen prüfen, ob die ID Spalte auch gefüllt ist!!
If Trim(CStr(txt_Nachname.Text)) = "" Then
'Meldung ausgeben
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 7 'Start in Zeile 7, Zeile 6 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle1.Cells(lZeile, 1).Value = LaufendeNummer.Text
Tabelle1.Cells(lZeile, 2).Value = Trim(CStr(txt_Nachname.Text))
Tabelle1.Cells(lZeile, 3).Value = Trim(CStr(txt_Vorname.Text))
Tabelle1.Cells(lZeile, 4).Value = txt_DG.Text
Tabelle1.Cells(lZeile, 5).Value = txt_TE.Text
Tabelle1.Cells(lZeile, 6).Value = txt_PK.Text
Tabelle1.Cells(lZeile, 7).Value = txtstatus.Text
Tabelle1.Cells(lZeile, 8).Value = txtStatusUnterlagen.Text
Tabelle1.Cells(lZeile, 9).Value = nächster_termin.Text
FillMyDateCells lZeile, 10, Me.txtG20
Tabelle1.Cells(lZeile, 11).Value = checkbox_G20.Text
FillMyDateCells lZeile, 12, Me.txtg24
Tabelle1.Cells(lZeile, 13).Value = checkbox_G24.Text
FillMyDateCells lZeile, 14, Me.txtG25
Tabelle1.Cells(lZeile, 15).Value = checkbox_G25.Text
FillMyDateCells lZeile, 16, Me.txtg26
Tabelle1.Cells(lZeile, 17).Value = checkbox_G26.Text
FillMyDateCells lZeile, 18, Me.txtG26_2
Tabelle1.Cells(lZeile, 19).Value = checkbox_G26_2.Text
FillMyDateCells lZeile, 20, Me.txtG29
Tabelle1.Cells(lZeile, 21).Value = checkbox_G29.Text
FillMyDateCells lZeile, 22, Me.txtG31
Tabelle1.Cells(lZeile, 23).Value = checkbox_G31.Text
FillMyDateCells lZeile, 24, Me.txtG33
Tabelle1.Cells(lZeile, 25).Value = checkbox_G33.Text
FillMyDateCells lZeile, 26, Me.txtG37
Tabelle1.Cells(lZeile, 27).Value = checkbox_G37.Text
FillMyDateCells lZeile, 28, Me.txtG41
Tabelle1.Cells(lZeile, 29).Value = checkbox_G41.Text
FillMyDateCells lZeile, 30, Me.txtG46
Tabelle1.Cells(lZeile, 31).Value = checkbox_G46.Text
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der txt_Nachname (ID) geändert hat
If ListBox1.Text <> Trim(CStr(txt_Nachname.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
'Dein Code
End Sub
----------------------------------------------------------------------------------------------
'Beenden Schaltfläche Ereignisroutine
Private Sub schliessen_Button_Click()
Unload Me
End Sub
----------------------------------------------------------------------------------------------
Private Sub txtG46_AfterUpdate()
If IsDate(txtG46) Then txtG46 = Format(txtG46, "MMM.YY")
End Sub
Private Sub txtG46_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(txtG46) Then
txtG46 = ""
Cancel = True
End If
End Sub
----------------------------------------------------------------------------------------------
'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Dim lZeile As Long
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle1 heraus und tragen die Daten
'in die TextBoxen ein.
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
LaufendeNummer = ""
txt_Nachname = ""
txt_Vorname = ""
txt_DG = ""
txt_TE = ""
txt_PK = ""
txtstatus = ""
txtStatusUnterlagen = ""
nächster_termin = ""
Me.txtG20 = vbNullString
checkbox_G20 = ""
Me.txtg24 = vbNullString
checkbox_G24 = ""
Me.txtG25 = vbNullString
checkbox_G25 = ""
Me.txtg26 = vbNullString
checkbox_G26 = ""
Me.txtG26_2 = vbNullString
checkbox_G26_2 = ""
Me.txtG29 = vbNullString
checkbox_G29 = ""
Me.txtG31 = vbNullString
checkbox_G31 = ""
Me.txtG33 = vbNullString
checkbox_G33 = ""
Me.txtG37 = vbNullString
checkbox_G37 = ""
Me.txtG41 = vbNullString
checkbox_G41 = ""
Me.txtG46 = vbNullString
checkbox_G46 = ""
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
lZeile = 7 'Start in Zeile 7, Zeile 6 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 2
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) Then
'TextBoxen füllen
LaufendeNummer = Tabelle1.Cells(lZeile, 1).Value
txt_Nachname = ListBox1.List(ListBox1.ListIndex, 0)
txt_Vorname = ListBox1.List(ListBox1.ListIndex, 1)
txt_DG = Tabelle1.Cells(lZeile, 4).Value
txt_TE = Tabelle1.Cells(lZeile, 5).Value
txt_PK = Tabelle1.Cells(lZeile, 6).Value
txtstatus = Tabelle1.Cells(lZeile, 7).Value
txtStatusUnterlagen = Tabelle1.Cells(lZeile, 8).Value
nächster_termin = Tabelle1.Cells(lZeile, 9).Value
FillAndFormatDate2DateText Me.txtG20, Tabelle1.Cells(lZeile, 10).Value
checkbox_G20 = Tabelle1.Cells(lZeile, 11).Value
FillAndFormatDate2DateText Me.txtg24, Tabelle1.Cells(lZeile, 12).Value
checkbox_G24 = Tabelle1.Cells(lZeile, 13).Value
FillAndFormatDate2DateText Me.txtG25, Tabelle1.Cells(lZeile, 14).Value
checkbox_G25 = Tabelle1.Cells(lZeile, 15).Value
FillAndFormatDate2DateText Me.txtg26, Tabelle1.Cells(lZeile, 16).Value
checkbox_G26 = Tabelle1.Cells(lZeile, 17).Value
FillAndFormatDate2DateText Me.txtG26_2, Tabelle1.Cells(lZeile, 18).Value
checkbox_G26_2 = Tabelle1.Cells(lZeile, 19).Value
FillAndFormatDate2DateText Me.txtG29, Tabelle1.Cells(lZeile, 20).Value
checkbox_G29 = Tabelle1.Cells(lZeile, 21).Value
FillAndFormatDate2DateText Me.txtG31, Tabelle1.Cells(lZeile, 22).Value
checkbox_G31 = Tabelle1.Cells(lZeile, 23).Value
FillAndFormatDate2DateText Me.txtG33, Tabelle1.Cells(lZeile, 24).Value
checkbox_G33 = Tabelle1.Cells(lZeile, 25).Value
FillAndFormatDate2DateText Me.txtG37, Tabelle1.Cells(lZeile, 26).Value
checkbox_G37 = Tabelle1.Cells(lZeile, 27).Value
FillAndFormatDate2DateText Me.txtG41, Tabelle1.Cells(lZeile, 28).Value
checkbox_G41 = Tabelle1.Cells(lZeile, 29).Value
FillAndFormatDate2DateText Me.txtG46, Tabelle1.Cells(lZeile, 30).Value
checkbox_G46 = Tabelle1.Cells(lZeile, 31).Value
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End If
End Sub
----------------------------------------------------------------------------------------------
Private Sub FillAndFormatDate2DateText(ByVal ctl As Control, ByVal myText As String)
If IsDate(myText) Then
ctl = Format(myText, "MMM YYYY")
Else
ctl = vbNullString
End If
End Sub
----------------------------------------------------------------------------------------------
Private Sub txtG24_AfterUpdate()
If IsDate(txtg24) Then txtg24 = Format(txtg24, "MMM YYYY")
End Sub
Private Sub txtG24_Change()
End Sub
----------------------------------------------------------------------------------------------
Private Sub txtG24_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(txtg24) Then
txtg24 = ""
Cancel = True
End If
End Sub
----------------------------------------------------------------------------------------------
Private Sub UserForm_Activate()
'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen
'jedoch nur, wenn auch Einträge in der Liste stehen
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub
----------------------------------------------------------------------------------------------
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
Dim lZeile As Long
'Alle TextBoxen leer machen
LaufendeNummer = ""
txt_Nachname = ""
txt_Vorname = ""
txt_DG = ""
txt_TE = ""
txt_PK = ""
txtstatus = ""
txtStatusUnterlagen = ""
nächster_termin = ""
Me.txtG20 = vbNullString
checkbox_G20 = ""
Me.txtg24 = vbNullString
checkbox_G24 = ""
Me.txtG25 = vbNullString
checkbox_G25 = ""
Me.txtg26 = vbNullString
checkbox_G26 = ""
Me.txtG26_2 = vbNullString
checkbox_G26_2 = ""
Me.txtG29 = vbNullString
checkbox_G29 = ""
Me.txtG31 = vbNullString
checkbox_G31 = ""
Me.txtG33 = vbNullString
checkbox_G33 = ""
Me.txtG37 = vbNullString
checkbox_G37 = ""
Me.txtG41 = vbNullString
checkbox_G41 = ""
Me.txtG46 = vbNullString
checkbox_G46 = ""
'In dieser Routine laden wir alle vorhandenen
'Einträge in die ListBox1
ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 7 'Start in Zeile 7, Zeile 6 sind ja die Überschriften
'Schleife solange etwas in der zweiten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle1.Cells(lZeile, 2).Value)) <> ""
'Aktuelle Zeile in die ListBox eintragen
ListBox1.AddItem
ListBox1.List(ListBox1.ListCount - 1, 0) = Cells(lZeile, 2).Text
ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(lZeile, 3).Text
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
Private Sub FillMyDateCells(ByVal iRow As Long, ByVal ICol As Long, ByVal dateValue As String)
With Tabelle1
If IsDate(dateValue) Then
.Cells(iRow, ICol) = CDate(dateValue)
Else
.Cells(iRow, ICol) = vbNullString
End If
End With
End Sub
