Кнопка Excel VBA теряет функциональность при перемещении - PullRequest
0 голосов
/ 16 июня 2020

У меня проблема с кнопкой, которую я создал с помощью 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

Эти два макроса вместе используются для удаления записей, которые были введены в таблицу. Когда вводится запись, рядом с ней создается кнопка удаления для удаления этой конкретной записи.

Проблема возникает, когда на одном листе имеется несколько записей. Удаление записи приводит к смещению всех следующих записей вверх. Когда после этого нажимается любая другая кнопка удаления, ничего не происходит.

Я считаю, что это происходит именно из-за перемещения кнопки удаления с исходного места, хотя я не совсем уверен и буду продолжать исследуйте это.

Кто-нибудь знает, есть ли способ t ie макрос для кнопки, чтобы она активировалась независимо от того, переместилась кнопка или нет? Это было бы идеальным решением, но если это невозможно, я go сделаю другой маршрут с этим удалением.

Насколько я понимаю, макрос не «привязан» к ячейке, в которой он расположен, он просто помещается туда того же размера, что и ячейка под ним. Правильно ли я это понимаю?

Любая обратная связь будет принята с благодарностью. Спасибо за чтение.

Изменить: Нашел ответ благодаря @Rory. Он предоставил мне ActiveSheet.Buttons (Application.Caller) .TopLeftCell, который привел меня к следующему ответу: Excel VBA - получить соответствующий диапазон для объекта интерфейса кнопки

Спасибо всем, кто внес свой вклад . Я принял другой ответ в качестве решения, чтобы ответить на этот вопрос, поскольку я не знал, как принять комментарий от пользователя и ответ. Есть ли способ сделать это? Еще раз спасибо.

1 Ответ

2 голосов
/ 16 июня 2020

Для этого типа использования гиперссылка была бы гораздо более полезной / надежной - она ​​фактически содержится в строке, поэтому всегда будет перемещаться вместе с остальными данными, и вы можете надежно использовать ее местоположение, чтобы определить, какая строка нуждается в необходимо действовать.

Добавьте ссылку «удалить» - например:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...