Buttons.add
29.11.2022 12:30:00
MMRH
ich habe eine Exceltabelle, die, bezogen auf ein bestimmtes Jahr, in einer bestimmten Zelle den String "Archivierung prüfen!" generiert.
Ist z.B. in A2 das Jahr 2010, wird in B2, 2020 generiert, und da 2020 hinter dem heutigen Datum liegt, wird der o.g. String über C2 generiert.
Auf C2 würde ich nun gerne einen Button hinzufügen, über den ein weiteres Makro ausgelöst werden kann.
Dazu habe ich zwei Methoden, die beide ihre Nachteile haben:
Methode 1:
Dim loopcounter As Long
Dim numberofcells As Long
numberofcells = Range("B2", Range("B2").End(xlDown)).Count ' Zählt die Zellenanzahl in der Range B2 = alles unter B1 in der die Tabellenüberschrift fehlt
For loopcounter = 2 To numberofcells + 1 'plus 1 nötig, da wir bei B2 und nicht B1 angefangen haben.
If Cells(loopcounter, 11).Value = "Archivierung prüfen!" Then
ActiveSheet.Buttons.Add(1189.5, (loopcounter - 1) * 15, 85.5, 15).Select '1189.5, 14.25, 85.5, 14.25 (.Left, .Top, .Width, .Height)
Selection.Characters.Text = "Archivieren!"
With Selection.Characters(Start:=1, Length:=12).Font 'Gibt an auf wie viele Zeichen sich das nachvolgende bezieht: Archivieren! = 11 Zeichen
.Name = "Calibri"
.FontStyle = "Standard"
.Size = 8
End With
Selection.OnAction = "Archivieren" 'ruft das entsprechende Makro auf
End If
Next
Application.ScreenUpdating = True
Dim anzahlderzeilen As Integer
anzahlderzeilen = Range("A1", Range("A1").End(xlDown)).Cells.Count
Dim rng As Range
Dim cell As Range
Set rng = Range(Cells(2, 11), Cells(anzahlderzeilen, 11))
For Each cell In rng
If cell.Value = "Archivierung prüfen!" Then
With cell
With .Parent.Buttons.Add(.Left + 10, .Top, .Width, .Height)
.Visible = True
.Caption = "Archivieren!"
.Name = "Add" & rng.Row
.Select
With Selection
.OnAction = "Archivieren"
End With
'.Size = 8
'.Selection.OnAction = "Archivieren"
End With
End With
End If
Next cell
Frage hierzu: Woran liegt es, dass die Buttons immer weiter verschoben werden?
Methode 2 hat dieses Problem nicht. Die Buttons sind immer perfekt über der gesamten Zelle, die den String enthält. Leider wird das Folgemakro beim ersten button den ich anklicke, und auch nur bei diesem, nicht für die Inhalte unter dessen Zelle ausgeführt. Beim zweiten ausgewählten Button läuft das Makro dann für die richtige Zeile, die sich unter dem geklickten Button befindet.
Das Folgemakro ist:
Sub archivieren
Dim b As Object, cs As Integer, rs As Integer
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
cs = .Column
rs = .Row
End With
Cells(rs, cs).Select 'von hier aus muss eine offsetfindung erfolgen und die löschung/archivierung angewiesen werden.
ActiveCell.Offset(0, -3).Select 'Fällt auf Spalte H mit dem Dateinamen und Link
'oben cells(rs +1, cs) geändert
Weitere Frage: Beide Methoden dauern sehr lang. Habe ich z.B. eine Liste mit 700 veralteten Einträgen, dauert die Generierung der Buttons lang. GIbt es einen anderen Ansatz, bei dem ich in einer Tabelle entahltene veraltete Einträge markieren kann und diese per Makro "weiterbehandeln" kann?
Dank im Voraus.