Question

我正在尝试做什么...

如果单元格A1中有某些内容，则获取一个按钮以自动显示在单元格H1中。如果在A1下方的单元格中有更多内容，则对于列下的多个按钮，这将继续。使用时，每个按钮都会将单元格的内容从使用按钮的同一行中的A列切换到G，然后将其粘贴到另一张纸的第一个空白行中，然后删除使用过的按钮。

第一个问题......

如果A1不为空，则在H1中添加按钮。如果A1为空，则删除/删除H1中的按钮。

编辑1：

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.Buttons.Add(423.75, 0, 48, 15).Select
    'ActiveSheet.Shapes("Button1").Name = "Button1"
    Selection.Name = "Button1"
    Selection.Characters.Text = "REMOVE"
    With Selection.Characters(Start:=1, Length:=6).Font
        .Name = "Calibri"
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
End Sub

问题是使用if语句放置多个按钮，每个按钮的名称为“Button”，后跟其中的行数（Button1，Button2等）。

编辑2：

标题更改。

旧 - excel vba - 添加/删除按钮和单元格范围

新建 - excel vba - 根据单元格值自动添加/删除按钮

Answer 1

这将在A1：A10中有内容的任何行上添加一个按钮，如果没有内容，则删除任何现有按钮（由此代码添加）

Sub Macro1()

    Dim c As Range, sht As Worksheet, btn, btnName As String

    Set sht = ActiveSheet

    For Each c In sht.Range("A1:A10").Cells '<< cells to check for content

        btnName = "btnRow_" & c.Row 'name the button according to the row

        If Len(c.Value) > 0 Then
            With c.EntireRow.Cells(1, "H")
                Set btn = sht.Buttons.Add(.Left, .Top, .Width, .Height)
            End With
            btn.Name = btnName
            btn.Characters.Text = "REMOVE"
        Else
            'delete the button if it exists (ignore any error if not found)
            On Error Resume Next
            sht.Shapes(btnName).Delete
            On Error GoTo 0
        End If

    Next c

End Sub

Answer 2

这是我所寻找的最终结果。感谢您的帮助。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim This As Worksheet, _
        RemoveButton, _
        ButtonName As String

    Set This = Sheets("SheetName1")
    ButtonName = "REMOVE" & Target.Row

    If Target.Column = 1 Then
        If This.Range("$A$" & Target.Row) <> "" Then
            On Error Resume Next
            This.Shapes(ButtonName).Delete
            On Error GoTo 0

            With Target.EntireRow.Cells(1, "H")
                Set RemoveButton = This.Buttons.Add(.Left, _
                                                    .Top, _
                                                    .Width, _
                                                    .Height)
            End With

            RemoveButton.Name = ButtonName
            RemoveButton.Characters.Text = "REMOVE"
            RemoveButton.OnAction = "REMOVE_BUTTON_ACTION"
        Else
            On Error Resume Next
            This.Shapes(ButtonName).Delete
            On Error GoTo 0
        End If
    End If
End Sub

有一些错误，但它们似乎不是什么大不了的事。例如，如果我在A列中粘贴多行，那么它只会在粘贴范围的第一行中创建一个按钮。

Sub REMOVE_BUTTON_ACTION()
    Dim RemoveButton As Object, _
        ButtonColumn As Integer, _
        ButtonRow As Integer, _
        RemovedSheetRow As Integer

    Set RemoveButton = ActiveSheet.Buttons(Application.Caller)
    With RemoveButton.TopLeftCell
        ButtonRow = .Row
    End With
    RemovedSheetRow = Worksheets("SheetName2").Range("$J$1").Value + 1

    Range("A" & ButtonRow & ":G" & ButtonRow).Cut _
        Destination:=Sheets("SheetName2").Range("A" & RemovedSheetRow)
End Sub

我在J1中存储了一个值，用于包含A列中某些内容的单元格数.J1实际上包含COUNTIFS（）公式。

再次感谢所有的帮助。

excel vba - 根据单元格值自动添加/删除按钮

2 个答案: