excel vba add form button to each row

问题

I have code to add buttons to each row of a spreadsheet, what I want to have happen is when the button is clicked on a given row certain cells will update on that row. My code adds the buttons to the correct row, and when clicked the buttons update the right columns, but each button in every row is only updating the first row, in this case 5, since that is where I start (with variable i). It seems that the .row function is always returning the top row. Any idea why this is the case?

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

回答1:

You're giving your buttons all the same name.

Try something like:

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

来源：https://stackoverflow.com/questions/42102089/excel-vba-add-form-button-to-each-row

标签

excel

vba

excel-vba