Кнопка «Удалить» или гиперссылка на каждую строку таблицы Excel - PullRequest
0 голосов
/ 19 января 2020

Могу ли я вставить кнопку удаления (или гиперссылку и т. Д. c) в каждую строку таблицы Excel, чтобы пользователь мог удалить эту текущую строку? Это возможно даже с одной строкой кода, как у меня ниже? я могу получить текущий индекс строки, чтобы показать в ячейке, но не знаю, как заставить эту ячейку что-то щелкнуть и перейти к функции с помощью VBA :)

Я пытался найти в документации Microsoft, но удалить документацию метода пока не помогло

Sub Test()

Dim sheet As Worksheet
Dim list As ListObject
Dim row As ListRow

Set sheet = Sheets("Sheet1")
Set list = sheet.ListObjects(1)
Set row = list.ListRows.Add


row.Range(1, 1).Value = sheet.Range("C7").Value
row.Range(1, 2).Value = sheet.Range("C4").Value
row.Range(1, 3).Value = sheet.Range("C8").Value
row.Range(1, 4).Value = sheet.Range("C6").Value
row.Range(1, 5).Value = sheet.Range("C10").Value
row.Range(1, 6).Value = sheet.Range("C11").Value
row.Range(1, 7).Value = "Delete button" ' call deleteRow and pass id there

End Sub

Sub deleteRow(id)

Dim sheet As Worksheet

Set sheet = ActiveSheet
sheet.ListObjects("Table").ListRows(id).Delete

End Sub

1 Ответ

0 голосов
/ 20 января 2020

Попробуйте этот демонстрационный код, просто вставьте его в новую книгу и запустите макрос createTable. Вы должны увидеть таблицу с гиперссылками, которые удаляют строку. Однако он может не подходить для больших таблиц, поскольку он изменяет размеры таблицы и обновляет ссылки после каждого удаления.


     Dim objListObj As ListObject
     Dim objListRows As ListRows

     Sub createTable()
         ThisWorkbook.Sheets(1).ListObjects.Add(xlSrcRange, _
         Range("$A1:H10"), , xlNo).Name = "Table1"
         Call addLinks
     End Sub


     Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

       If objListObj Is Nothing Then
         Set objListObj = ThisWorkbook.Sheets(1).ListObjects(1)
         Set objListRows = objListObj.ListRows
       End If

       ar = Split(Range(Target.SubAddress).Value, " ")
       MsgBox "Deleting Row " & ar(2)
       objListRows(ar(2)).Delete

       Dim newsize As Integer
       Let newsize = objListObj.Range.Rows.Count
       objListObj.Resize Range("A1:H" & newsize)
       Call addLinks

     End Sub

     Sub addLinks()

      Dim ws As Worksheet

      Set ws = ActiveWorkbook.Worksheets("Sheet1")
      Set objListObj = ws.ListObjects(1)
      Set objListRows = objListObj.ListRows
      Dim i As Integer, rng As Range

      For i = 1 To objListRows.Count
        Set rng = objListRows(i).Range.Columns(7)
        ws.Hyperlinks.Add Anchor:=rng, _
        Address:="", SubAddress:=rng.Address, _
        TextToDisplay:="Delete row " & i
      Next i

     End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...