Excel VBA添加表单按钮到每一行 [英] excel vba add form button to each row

问题描述

我有代码向电子表格的每一行添加按钮，我想发生的事情是，当在给定的行上单击按钮时，某些单元格将在该行上更新.我的代码将按钮添加到正确的行，单击该按钮将更新右列，但是每行中的每个按钮仅更新第一行，在这种情况下为5，因为这是我开始的地方(变量i).似乎.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

推荐答案

您为按钮指定了相同的名称.

You're giving your buttons all the same name.

尝试类似的东西:

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

这篇关于Excel VBA添加表单按钮到每一行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！