【问题标题】:Button Loses Functionality When Moved按钮在移动时失去功能
【发布时间】:2020-06-16 15:54:16
【问题描述】:

我使用 Excel VBA 创建了一个按钮。

'Set dltBtn equal to t's position and size.
Set dltBtn = activeSheet.Buttons.Add(u.Left, u.Top, u.Width, u.Height)

'Start of With.
With dltBtn
    
    'Macro that is called when dltBtn is clicked.
    .OnAction = "'ESQDeleteRecord " & u.Column & "," & u.Row & "'"
    'Caption of dltBtn, shown to the user.
    .Caption = "Delete ESQ Record"
    'Name of dltBtn, used by Excel.
    .Name = "ESQ Delete Button"
    
'End of With.
End With

此代码在所需位置创建一个大小正确的按钮。它运行正常,因为单击删除按钮将激活以下宏:

'Sub to process when a record is chosen for deletion.
Sub ESQDeleteRecord(ByVal colPos As Integer, rowPos As Integer)

'MsgBox "I respond to clicking."

'Declares a Checkbox named cb.
Dim cb As CheckBox
Dim deleteRange As Range
Dim msgRes As VbMsgBoxResult
Dim count As Integer

'Start of for loop which will run from count up to 17.
For count = 1 To 17
    On Error Resume Next

    'Start of if statement which says if the cell's value two cells to the left and up until it hits a non-blank cell of the Target cell is equal to ESQ.
    If Cells(rowPos - count, colPos + 1).Value = "ESQ" Then

        'If Cells(rowPos - count, colPos + 1).Value <> "Legacy" Then

            'Set deleteRange = Range(Cells(rowPos, colPos + 1), Cells(rowPos - 17, colPos + 1))

            msgRes = MsgBox("Proceed to delete ESQ Record?", vbOKCancel, "ESQ Record Delete")

            If msgRes = vbOK Then

                Set deleteRange = Range(Cells(rowPos, colPos + 1), Cells(rowPos - 17, colPos + 1))

                For Each cb In activeSheet.CheckBoxes

                    If Not Intersect(cb.TopLeftCell, deleteRange) Is Nothing Then

                        cb.Delete

                    End If

                Next cb

            End If

            deleteRange.EntireRow.Delete

            Exit For

        'End If

    End If

Next count

End Sub

这两个宏组合用于删除已输入到表中的记录。输入记录时,会在其旁边创建删除该特定记录的删除按钮。

当一个工作表中有多个记录时,就会出现问题。删除记录会导致以下所有记录上移。在此之后单击任何其他删除按钮时,没有任何反应。

我相信删除按钮从原来的位置移动是导致这种情况发生的原因。

有没有一种方法可以将宏绑定到按钮上,以便无论按钮是否移动,它都会激活?那将是理想的解决方案,但如果不可能,我将采取另一条删除路线。

据我了解,宏没有“链接”到它所在的单元格,它只是以与其下方单元格相同的大小放置在那里。我理解正确吗?

编辑:感谢@Rory,找到了答案。他给我提供了ActiveSheet.Buttons(Application.Caller).TopLeftCell,这让我找到了Excel VBA - Get corresponding Range for Button interface object

我接受了一个不同的答案作为这个问题的答案,因为我不知道如何接受评论作为答案。

【问题讨论】:

  • 这就是为什么你不应该在没有wb/ws的情况下使用Cells的原因
  • 顺便把On Error Resume Next去掉,它只是隐藏了潜在的错误。
  • 您可以使用Activesheet.Buttons(Application.Caller).Topleftcell 获取对单击按钮左上角下方单元格的引用。这样您就不必担心使用Onaction 传递参数(最好避免)或担心按钮向上或向下移动行但它们的宏仍然引用旧的行号。
  • @BigBen 谢谢,我会试试的。
  • @Rory 那我应该将该行放在删除记录按钮宏中吗?

标签: excel vba


【解决方案1】:

对于这种类型的用例,超链接会更有用/更强大 - 它实际上包含在行中,因此始终与其余数据一起移动,您可以可靠地使用它的位置来确定需要哪一行采取行动。

添加“删除”链接 - 例如:

Sub Setup()
    Dim u As Range
    For Each u In Range("B2:B10")
        u.Parent.Hyperlinks.Add u, _
             Address:="", SubAddress:="'" & u.Parent.Name & "'!" & u.Address(False, False), _
             TextToDisplay:="Delete"
    Next u
End Sub

在工作表代码模块中:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim rng As Range
    Select Case Target.TextToDisplay
        Case "Delete"
            Set rng = Target.Range.Offset(1)
            Target.Range.EntireRow.Delete
            rng.Select
    End Select
End Sub

【讨论】:

  • 您好,感谢您的回答。我明天必须回复你这个解决方案是否有效。再次感谢。
  • 感谢您的建议。我以另一种方式找到了答案,但接受了您的答案作为结束问题的答案。再次感谢。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2011-12-24
  • 2022-10-13
  • 1970-01-01
  • 2013-12-09
  • 1970-01-01
  • 2018-02-15
相关资源
最近更新 更多