Question

我有代码向电子表格的每一行添加按钮，我想要发生的是当在给定行上单击按钮时，某些单元格将在该行上更新。我的代码将按钮添加到正确的行，单击时按钮会更新右列，但每行中的每个按钮仅更新第一行，在本例中为5，因为这是我开始的地方（使用变量i）。似乎.row函数总是返回顶行。知道为什么会这样吗？

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

你给的按钮都是同一个名字。

尝试类似：

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为每一行添加表单按钮

1 个答案: