Excel VBA hinzufügen Formular-Taste zu jeder Zeile

Question

Ich habe Code, um Schaltflächen zu jeder Zeile einer Tabelle hinzuzufügen, was ich geschehen möchte ist, wenn die Schaltfläche auf eine bestimmte Zeile geklickt wird bestimmte Zellen in dieser Zeile aktualisiert werden. Mein Code fügt die Knöpfe zur richtigen Reihe hinzu, und wenn geklickt wird, aktualisieren die Knöpfe die rechten Spalten, aber jede Taste in jeder Reihe aktualisiert nur die erste Reihe, in diesem Fall 5, da ich dort (mit der Variablen i) beginne. Es scheint, dass die .row-Funktion immer die oberste Zeile zurückgibt. Irgendeine Idee warum das der Fall ist?

Sub Button1_Click() 

Dim btn As Button 
Sheets(foldername).Buttons.Delete 
Dim t As Range 
For i = 5 To Sheets(foldername).Cells(Rows.Count, "A").End(xlUp).Row 
Set t = Sheets(foldername).Range(Cells(i, 10), Cells(i, 10)) 
Set btn = Sheets(foldername).Buttons.Add(t.Left, t.Top, t.Width, t.Height) 
With btn 
    .OnAction = "Createbutton" 
    .Caption = "Preparer" 
    .Name = "Preparer" 
End With 
Next I 
end sub 

Sub CreateButton() 

'code that is used to inject into each button that is created 

Dim b As Object, cs As Integer, RowNumber As Long 
Set b = ActiveSheet.Buttons(Application.Caller) 
With b.TopLeftCell 
    cs = .Column 
    RowNumber = .Row 
End With 

If ActiveSheet.Cells(RowNumber, "F").Value = vbNullString Then 
ActiveSheet.Cells(RowNumber, "F").Value = "User: " &  
Application.UserName & vbNewLine & "Date: " & Date 
Else 
ActiveSheet.Cells(RowNumber, "F").Value = vbNullString 
ActiveSheet.Cells(RowNumber, "F").Interior.ColorIndex = 2 
ActiveSheet.Cells(RowNumber, "F").Font.Color = vbBlack 
GoTo skiptoend: 
End If 

If Date <= ActiveSheet.Cells(RowNumber, "E").Value Then 
ActiveSheet.Cells(RowNumber, "F").Font.Color = RGB(1, 125, 33) 
ActiveSheet.Cells(RowNumber, "F").Interior.Color = RGB(0, 255, 127) 
Else 
ActiveSheet.Cells(RowNumber, "F").Font.Color = vbRed 
ActiveSheet.Cells(RowNumber, "F").Interior.Color = RGB(255, 204, 204) 
End If 

skiptoend: 


End Sub 

Answer 1

Sie geben Ihren Tasten den gleichen Namen.

Probieren Sie etwas wie:

Sub Button1_Click() 
    Dim btn As Button, t As Range, sht As Worksheet, i As Long 

    Set sht = Sheets(FolderName) 

    sht.Buttons.Delete 

    For i = 5 To sht.Cells(Rows.Count, "A").End(xlUp).Row 
     Set t = sht.Cells(i, 10) 
     Set btn = sht.Buttons.Add(t.Left, t.Top, t.Width, t.Height) 
     With btn 
      .OnAction = "Createbutton" 
      .Caption = "Preparer" 
      .Name = "Preparer_" & i 
     End With 
    Next i 
End Sub 

Sub CreateButton() 

    Dim RowNumber As Long, sht As Worksheet 
    Dim c As Range 

    Set sht = ActiveSheet 

    RowNumber = CLng(Split(Application.Caller, "_")(1)) 

    Set c = sht.Cells(RowNumber, "F") 

    If c.Value = vbNullString Then 
     c.Value = "User: " & Application.UserName & vbNewLine & "Date: " & Date 

     If Date <= ActiveSheet.Cells(RowNumber, "E").Value Then 
      c.Font.Color = RGB(1, 125, 33) 
      c.Interior.Color = RGB(0, 255, 127) 
     Else 
      c.Font.Color = vbRed 
      c.Interior.Color = RGB(255, 204, 204) 
     End If 
    Else 
     c.Value = vbNullString 
     c.Interior.ColorIndex = 2 
     c.Font.Color = vbBlack 
    End If 

End Sub