Command Button auf mehreren Sheets
08.11.2021 18:32:39
Daniel
seit Monaten ziehe ich aus diesem tollen Forum für meine beruflichen Zwecke viel Wissen und Erfahrung. Ich habe ein Excel-Tool erstellt, welches die Arbeits- und Planungsgrundlage für ca. 20 Fachkräfte darstellt. Erfasst wird der Bedarf für psychologische Tests in unterschiedlichen Reha-Maßnahmen dutzender Patienten (x = Testbedarf; p=Test in Planung; e=Test erledigt). Momentan habe ich folgendes Problem: In Spalte A der Tabelle kann der Status des Patienten geändert werden: Es erscheint beim Anwählen des Namens (Spalte A oder B) ein kleiner dynamischer Button mit "?", der bei Click abfragt, ob der Patient aus dem Register markiert und die geplanten Testeinträge entfernt werden sollen (rot, kursiv, durchgestrichen; e + p werden entfernt). Das klappt auf Tabelle1 wunderbar.
Sobald ich diese Prozedur als Code auf andere Tabellenblätter übertrage, kommen Laufzeitfehler. Ich habe bereits versucht, den CommandButton durch mehrere Nummern abweichend zu benennen, aber es bringt nichts. Ich bitte daher um Eure Mithilfe. Was übersehe ich? Was fehlt da? Hier der Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A5:B1000")) Is Nothing Then
With ActiveSheet
With .CommandButton1
.Caption = "?"
.Top = 1: .Left = 1
.Width = 22: .Height = 21
.BackColor = 255
.Font.Name = "Arial"
.Font.Size = 11
End With
End With
ActiveSheet.CommandButton1.Visible = True
ActiveSheet.CommandButton1.Top = Cells(ActiveCell.Row, 1).Top
ActiveSheet.CommandButton1.Left = Cells(ActiveCell.Row, 1).Left
Else
ActiveSheet.CommandButton1.Visible = False
End If
End Sub
Private Sub CommandButton1_Click()
Dim rngZelle As Range
Dim MyRow&
MyRow = ActiveCell.Row
If MsgBox("Teilnehmer(in) dauerhaft als beendet markieren?" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Achtung:" & Chr(13) & Chr(10) & "- alle vorgesehenen (x) und geplanten (p) Tests werden entfernt" & Chr(13) & Chr(10) & "- erfolgte Tests bleiben erfasst", vbYesNoCancel) = vbYes Then
Range("A" & ActiveCell.Row & ":" & "C" & ActiveCell.Row).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A" & ActiveCell.Row & ":" & "I" & ActiveCell.Row).Select
With Selection.Font
.Strikethrough = True
.Italic = True
End With
Range("J" & ActiveCell.Row & ":" & "Z" & ActiveCell.Row).Select
With Selection
.Replace What:="x", Replacement:=""
.Replace What:="p", Replacement:=""
End With
Else
End If
End Sub