VBA Problem Button Wirkungsbereich anpassen

[Eagle Eye]

Hallo liebe Community, 

Vorab: Ich bin ein absoluter Neuling, was das programmieren von Excel anbelangt. Da ich aber für die Uni einen Wochenplan erstellen muss, der über mehrere Wochen geht habe ich mir eine Excel Vorlage genommen.
Diese Vorlage beinhaltet aber leider nur die Tage Mo-Fr, sodass ich Samstag und Sonntag ergänzen musste. Die eingefügten Buttons für die Priorisierung von Terminen und für das durchstreichen von erledigten Terminen scheinen aber nicht diese beiden hinzugefügten Zeilen anzuerkennen und Wirken in diesem Bereich nicht. Vor ein Paar Stunden habe ich dann angefangen mich mit den Entwicklertools auszuprobieren.

Dabei habe schon mehrere Probleme, die bei der Abänderung der Vorlage aufgetreten sind, beheben können, aber hier komme ich leider nicht weiter . Der Code ist von mir auch schon nach einer gegebenen Range für den Wirkungsbereich durchsucht worden, aber leider bin ich nicht fündig geworden (Muss ja alles komplizierter als einfache Zeilenbezüge sein . Habe das Excel angehangen und die Codes stehen unten:

Vielen Dank für Eure Hilfe!

Button A:

Code:

Option Explicit
Private Sub btnToggleTask_Click()
On Error Resume Next
Dim blnToggle As Boolean
If Selection.Cells.Count > 1 Then
    Exit Sub
End If
If Application.Intersect(Me.Range("Raster"), ActiveCell) Is Nothing Then
Exit Sub
Else
blnToggle = Selection.Font.Strikethrough
Selection.Font.Strikethrough = Not blnToggle
If blnToggle = False Then
    With Selection.Font
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = -0.35
    End With
Else
    With Selection.Font
      .ThemeColor = xlThemeColorLight1
      .TintAndShade = 0
    End With
End If
End If
End Sub
Private Sub cbxMarkImportance_Change()
On Error Resume Next
Dim rng As Range
Dim strPriority As String
Dim lngLen As Long
strPriority = UCase(Me.cbxMarkImportance.Text)
lngLen = Len(ActiveCell.Value)
Me.cbxMarkImportance.Text = "PRIORITÄT DES TERMINS AUSWÄHLEN"
If Application.Intersect(ActiveCell, Me.Range("Raster")) Is Nothing Then
Exit Sub
ElseIf strPriority <> "KEINE PRIORITÄT" And lngLen > 0 Then
For Each rng In TaskSetup.Range("ImportanceLevels")
  If StrComp(rng.Text, strPriority, vbTextCompare) = 0 Then
  ActiveCell.Offset(0, 1).Interior.Color = rng(1, 2).Interior.Color
  Exit For
  End If
Next rng
ElseIf strPriority = "KEINE PRIORITÄT" Then
ActiveCell.Offset(0, 1).ClearFormats
ElseIf lngLen = 0 Then
GoTo EndImportance
Else
For Each rng In TaskSetup.Range("ImportanceLevels")
  If StrComp(rng.Text, strPriority, vbTextCompare) = 0 Then
  ActiveCell.Interior.Color = rng(1, 2).Interior.Color
  Exit For
  End If
Next rng
End If
EndImportance:
ActiveCell.Select
End Sub

Private Sub cbxMarkImportance_GotFocus()

Button B:

Code:

Private Sub btnMarkTaskAsDone_Click()
If Selection.Cells.Count > 1 Then
    Exit Sub
End If
If Application.Intersect(Me.Range("Raster"), ActiveCell) Is Nothing Then
    Exit Sub
End If

If ActiveCell.Interior.Color = Me.Range("CompletionColor").Interior.Color Then
    ActiveCell.Interior.Color = Me.Range("DefaultRasterColor").Interior.Color
Else
    ActiveCell.Interior.Color = Me.Range("CompletionColor").Interior.Color
End If


End Sub

Private Sub cbxMarkImportance_Change()

Dim C As Long
Dim R As Range
Dim S As String
S = Me.cbxMarkImportance.Text
On Error Resume Next
If Application.Intersect(ActiveCell, Me.Range("Raster")) Is Nothing Then
    Exit Sub
End If
For Each R In Me.Range("ImportanceLevels")
    If StrComp(R.Text, S, vbTextCompare) = 0 Then
        ActiveCell.Interior.Color = R(1, 2).Interior.Color
        Exit Sub
    End If
Next R

End Sub

[Gast 123]

Hallo

den Code kann man etwas verkürzen, bei gleicher Funktion.  Der Fehler liegt eindeutig in der Festlegung von Me.Range("Master")
Wie man mit Select prüfen kann geht dieser Bereich NUR von Montag bis Freitag. Ich weiss aber nicht wo ihr den festgelegt habt?
Im Namensmanager für Workbbok Namen steht er nicht.  Die Festlegung muss auf jeden Fall geändert werden.

mfg Gast 123

Code:

Private Sub btnMarkTaskAsDone_Click()
If Selection.Cells.Count > 1 Then Exit Sub
If Application.Intersect(Me.Range("Raster"), ActiveCell) Is Nothing Then Exit Sub

If ActiveCell.Interior.Color = Me.Range("CompletionColor").Interior.Color Then
    ActiveCell.Interior.Color = Me.Range("DefaultRasterColor").Interior.Color
Else
    ActiveCell.Interior.Color = Me.Range("CompletionColor").Interior.Color
End If
End Sub



Private Sub cbxMarkImportance_Change()
Dim C As Long
Dim R As Range
Dim S As String
S = Me.cbxMarkImportance.Text
On Error Resume Next
If Application.Intersect(ActiveCell, Me.Range("Raster")) Is Nothing Then Exit Sub
For Each R In Me.Range("ImportanceLevels")
    If StrComp(R.Text, S, vbTextCompare) = 0 Then
        ActiveCell.Interior.Color = R(1, 2).Interior.Color
        Exit Sub
    End If
Next R
End Sub

[RPP63]

Der Fehler liegt eindeutig in der Festlegung von Me.Range("Master")
[…] Ich weiss aber nicht wo ihr den festgelegt habt?
Im Namensmanager für Workbbok Namen steht er nicht.

Moin!
"Raster" heißt der Bereichsname und muss im Namensmanager wie folgt geändert werden:

Code:

=tblWeeklySchedule1[[MONTAG]:[SONNTAG]]

Gruß Ralf

[Gast 123]

Hallo Ralf

man sieht das ich in Excel noch lange nicht alles weiss, aber clever genug bin mir zum Testen mit Select den Rang anzusehen.
Schön das der Frager jetzt weiss was er wo ändern muss. Gefällt mir ....Danke für deine Antwort.

mfg Gast 123

[Eagle Eye]

Super, vielen Dank für Eure Hilfe! Ist jetzt angepasst und funktioniert einwandfrei!