VBA Zeile farblich markieren
04.05.2019 11:24:41
Michael
in folgenden Code würde ich gerne, wenn Checkbox1 aktiviert ist, das die Zeile von A bis M gelb markiert wird.
Könnte mir da jemand helfen?
Viele Grüße
Michael
Private Sub Eingabe_Click()
Dim intErsteLeereZeile As Long
If Trim(CStr(Datum.Value)) = "" Then
'Wenn Datum fehlt, Meldung ausgeben
MsgBox "Bitte g?ltiges Einzahldatum angeben!", vbCritical + _
vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
If Trim(CStr(Abteilung.Value)) = "" Then
'Fehleremeldung wenn Angabe Abteilung fehlt, Meldung ausgeben
MsgBox "Bitte g?ltige Abteilung eingeben!", vbCritical + _
vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
If Trim(CStr(Vereinsbereich.Value)) = "" Then
'Fehleremeldung wenn Angabe Vereinsbereich fehlt
MsgBox "Bitte g?ltigen Vereinsbereich eingeben!", vbCritical + _
vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
If Trim(CStr(Einzahler.Value)) = "" Then
'Fehleremeldung wenn Angabe Einzahler fehlt
MsgBox "Bitte g?ltigen Einzahler eingeben!", vbCritical + _
vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
If Trim(CStr(Verwendungszweck.Value)) = "" Then
'Fehleremeldung wenn Angabe Verwendungszweck
MsgBox "Bitte g?ltigen Verwendungszweck eingeben!", vbCritical + _
vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
If Trim(CStr(Kostenartentxt.Value)) = "" Then
'Fehleremeldung wenn Angabe Kostenarten fehlt
MsgBox "Bitte g?ltige Kostenart eingeben!", vbCritical + _
vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
If Trim(CStr(GiroEin.Value)) = "" Then
'Wenn Textbox GiroEin leer dann 0 in Zelle GiroEin schreiben
Me.GiroEin.Value = 0
End If
If Trim(CStr(GiroAus.Value)) = "" Then
'Wenn Textbox GiroAus leer dann 0 in Zelle GiroAus schreiben
Me.GiroAus.Value = 0
End If
If Trim(CStr(Rechnung19Ein.Value)) = "" Then
'Wenn Textbox Rechnung19Ein leer dann 0 in Zelle Rechnung19Ein schreiben
Me.Rechnung19Ein.Value = 0
'Abbrechen der Speicherroutine
End If
If Trim(CStr(Rechnung19Aus.Value)) = "" Then
'Wenn Textbox Rechnung19Aus leer dann 0 in Zelle Rechnung19Aus schreiben
Me.Rechnung19Aus.Value = 0
End If
If Trim(CStr(Rechnung7Ein.Value)) = "" Then
'Wenn Textbox Rechnung7Ein leer dann 0 in Zelle Rechnung7Ein schreiben
Me.Rechnung7Ein.Value = 0
End If
If Trim(CStr(Rechnung7Aus.Value)) = "" Then
'Wenn Textbox Rechnung7Aus leer dann 0 in Zelle Rechnung7Aus schreiben
Me.Rechnung7Aus.Value = 0
End If
'Fragt ab ob Daten wirklich hinzugef?gt werden sollen
If MsgBox("Daten wirklich hinzuf?gen?", vbYesNo) = vbNo Then
'Wenn Abbrechen, dann schlie?t die Eingabemaske
Unload Me
Else
'Sucht in aktiver Tabelle, Spalte 3, die erste freie Spalte
'Passwortschutz des aktiven Arbeitsblattes aufheben
ActiveSheet.Unprotect Password:="Test"
'Sucht in aktiver Tabelle, Spalte 3, die erste freie Spalte
intErsteLeereZeile = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1
'und F?gt die eingetragenen Daten aus den Textboxen in die Tabelle ein
ActiveSheet.Cells(intErsteLeereZeile, 4).Value = CDate(Datum)
ActiveSheet.Cells(intErsteLeereZeile, 5).Value = Me.AbteilungTextbox.Text
ActiveSheet.Cells(intErsteLeereZeile, 7).Value = Me.bereichtxt.Text
ActiveSheet.Cells(intErsteLeereZeile, 8).Value = Me.Einzahler.Text
ActiveSheet.Cells(intErsteLeereZeile, 9).Value = Me.Verwendungszweck.Text
ActiveSheet.Cells(intErsteLeereZeile, 11).Value = Me.UmlageJatxt.Text
ActiveSheet.Cells(intErsteLeereZeile, 10).Value = Me.Kostenartentxt.Text
ActiveSheet.Cells(intErsteLeereZeile, 21).Value = Me.GiroEin.Value * 1
ActiveSheet.Cells(intErsteLeereZeile, 22).Value = Me.GiroAus.Value * 1
ActiveSheet.Cells(intErsteLeereZeile, 13).Value = Me.Rechnung19Ein.Value * 1
ActiveSheet.Cells(intErsteLeereZeile, 15).Value = Me.Rechnung19Aus.Value * 1
ActiveSheet.Cells(intErsteLeereZeile, 17).Value = Me.Rechnung7Ein.Value * 1
ActiveSheet.Cells(intErsteLeereZeile, 19).Value = Me.Rechnung7Aus.Value * 1
End If
'Passwortschutz des aktiven Arbeitsblattes setzen
ActiveSheet.Protect Password:="Test"
'Schlie?t die Eingabemaske
Unload Me
End Sub