Zelleingaben über eine UserForm

Private lngZeile As Long, lngLZ As Long
Private intSpalte As Integer, intLS As Integer
'

Private Sub UserForm_Initialize()
Dim d As Date

wksMonat.Activate

d = Cells(1, 1)

'Anzahl der Tage des Monats in A1
intLS = DateSerial(Year(d), Month(d) + 1, 1) - DateSerial(Year(d), Month(d), 1) + 1

'intLS = Cells(1, Columns.Count).End(xlToLeft).Column
lngLZ = Cells(Rows.Count, 1).End(xlUp).Row - 2

'---------------------------------------------------------
'damit gleich kein Fehler entsteht, muss der Cursor
'im Datenbereich stehen
If ActiveCell.Row < 3 Or ActiveCell.Row > lngLZ Then
  Cells(5, 8).Activate
End If
If ActiveCell.Column < 2 Or ActiveCell.Column > intLS Then
  Cells(5, 8).Activate
End If
'---------------------------------------------------------

'Datum aus Zeile 1 auslesen bis letzte Spalte mit Inhalt
'und in comboDatum eintragen:
For intSpalte = 2 To intLS
  frmEingabe.comboDatum.AddItem (Cells(1, intSpalte))
Next intSpalte

'Spalte A auslesen bis letzte Zeile mit Inhalt
'und in comboUhrzeit eintragen:
For lngZeile = 3 To lngLZ
  frmEingabe.comboUhrzeit.AddItem Format((Cells(lngZeile, 1)), "hh:mm")
Next lngZeile

With frmEingabe
  .comboDatum.ListIndex = ActiveCell.Column - 2
  .comboUhrzeit.ListIndex = ActiveCell.Row - 3
  .txtEingabe.Text = "A"
  .cmbEntfernen.Enabled = False
  .chbSofort = Range("AI1")
  .chbZeile = Range("AI2")
  .chbSpalte = Range("AI3")
End With

If Me.chbSofort.Value = True Then
  Me.cmbEingabe.Enabled = False
Else
  Me.cmbEingabe.Enabled = True
End If

Call Farbe

End Sub

Private Sub chbSofort_Click()
  If Me.chbSofort.Value = True Then
    Me.cmbEingabe.Enabled = False
  Else
    Me.cmbEingabe.Enabled = True
  End If

  Call Farbe
End Sub

Private Sub chbSpalte_Click()
  Call Farbe
  cmbEntfernen.Enabled = True
End Sub
Private Sub chbZeile_Click()
  Call Farbe
  cmbEntfernen.Enabled = True
End Sub

Private Sub txtEingabe_Change()
  If txtEingabe.Value = "" Then
    cmbEingabe.Enabled = False
  Else
    cmbEingabe.Enabled = True
  End If
End Sub

Private Sub Farbe()

On Error GoTo Fehler

wksMonat.Unprotect
  If Me.Visible = True Then
    Range("AI1") = Me.chbSofort
    Range("AI2") = Me.chbZeile
    Range("AI3") = Me.chbSpalte
  End If

  Range(Cells(3, 2), Cells(lngLZ, intLS)).Interior.ColorIndex = xlNone

  'ganze Zeile
  If chbZeile.Value = True Then
    Range(Cells(lngZeile, 2), Cells(lngZeile, intLS)).Interior.ColorIndex = 35
  End If

  'ganze Spalte
  If chbSpalte.Value = True Then
    Range(Cells(3, intSpalte), Cells(lngLZ, intSpalte)).Interior.ColorIndex = 35
  End If

wksMonat.Protect
Exit Sub

Fehler:
  MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine & _
         "Beschreibung: " & Err.Description, vbCritical, "Fehler"
End Sub

Private Sub comboDatum_Change()
  intSpalte = comboDatum.ListIndex + 2
  Call ZelleZeigen
End Sub

Private Sub comboUhrzeit_Change()
  lngZeile = comboUhrzeit.ListIndex + 3
  Call ZelleZeigen
End Sub

Private Sub ZelleZeigen()

If frmEingabe.Visible = True Then
  Call Farbe
  Cells(lngZeile, intSpalte).Select

  If chbSofort.Value = True Then

    'ganze Zeile ausfüllen
    If chbZeile.Value = True Then
      Range(Cells(lngZeile, 2), Cells(lngZeile, intLS)) = txtEingabe
    End If
    'ganze Spalte ausfüllen
    If chbSpalte.Value = True Then
      Range(Cells(3, intSpalte), Cells(lngLZ, intSpalte)) = txtEingabe
    End If

    Cells(lngZeile, intSpalte) = txtEingabe
  End If

  cmbEntfernen.Enabled = True
End If

End Sub

Private Sub cmbEntfernen_Click()

wksMonat.Unprotect

If chbZeile.Value = True Then
  Range(Cells(lngZeile, 2), Cells(lngZeile, intLS)) = ""
  Range(Cells(lngZeile, 2), Cells(lngZeile, intLS)).Interior.ColorIndex = 15
End If

If chbSpalte.Value = True Then
  Range(Cells(3, intSpalte), Cells(lngLZ, intSpalte)) = ""
  Range(Cells(3, intSpalte), Cells(lngLZ, intSpalte)).Interior.ColorIndex = 15
End If

wksMonat.Protect

If ActiveCell.Value <> "" Then
  ActiveCell = ""
End If

cmbEntfernen.Enabled = False
End Sub
Private Sub cmbEingabe_Click()

On Error GoTo Fehler

wksMonat.Unprotect
  'ganze Zeile ausfüllen
  If chbZeile.Value = True Then
    Range(Cells(lngZeile, 2), Cells(lngZeile, intLS)) = txtEingabe
    Range(Cells(lngZeile, 2), Cells(lngZeile, intLS)).Interior.ColorIndex = 35
  End If
  'ganze Spalte ausfüllen
  If chbSpalte.Value = True Then
    Range(Cells(3, intSpalte), Cells(lngLZ, intSpalte)) = txtEingabe
    Range(Cells(3, intSpalte), Cells(lngLZ, intSpalte)).Interior.ColorIndex = 35
  End If

ActiveCell.Interior.ColorIndex = 35
wksMonat.Protect

Cells(comboUhrzeit.ListIndex + 3, comboDatum.ListIndex + 2) = txtEingabe
cmbEntfernen.Enabled = True
Exit Sub

Fehler:
  MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine & _
         "Beschreibung: " & Err.Description, vbCritical, "Fehler"
End Sub

Private Sub cmbCancel_Click()
  Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, _
                             CloseMode As Integer)
  wksMonat.Unprotect

  'wg Demo Daten am Ende immer löschen
  With Range(Cells(3, 2), Cells(lngLZ, intLS))
    .Interior.ColorIndex = xlNone
    .Cells = ""
  End With

  wksMonat.Protect
End Sub