VBA - Удалить флажки и отсоединить от ячеек - PullRequest
0 голосов
/ 12 октября 2018

Я нашел здесь макрос (https://ccm.net/faq/37428-excel-vba-how-to-create-multiple-checkboxes), который будет создавать флажки в выбранном диапазоне - что здорово - но теперь я хотел бы сделать обратное, то есть удалить флажки в указанном диапазоне.

Вот код для создания флажков:

Sub Insert_chkbx_Link_Cell()
    Dim rngCel As Range
    Dim ChkBx As CheckBox

    For Each rngCel In Selection
        With rngCel.MergeArea.Cells
            If .Resize(1, 1).Address = rngCel.Address Then
                Set ChkBx = ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height)
                With ChkBx
                    .Value = xlOff
                    .LinkedCell = rngCel.MergeArea.Cells.Address
                    With .Border
                    End With
                End With
            End If
        End With
    Next rngCel
End Sub

Здесь подпрограмма, которая будет "отменять / отменять назначение" флажков из ячеек:

Sub Un_Assign()
    For Each sht In ActiveWorkbook.Sheets
        For Each CheckBox In sht.CheckBoxes
            CheckBox.OnAction = ""
        Next CheckBox
    Next sht
End Sub

Проблема в том, что он не делает этого для указанного диапазона И будет делать это для каждого рабочего листа.

Поэтому я изменил макрос, который создает флажки, на тот, который удаляет их:

Sub Remove_chkbx_Unlink_Cell()
    Dim rngCel As Range
    Dim ChkBx As CheckBox

    For Each rngCel In Selection
        With rngCel.MergeArea.Cells
            If .Resize(1, 1).Address = rngCel.Address Then
                ActiveSheet.CheckBoxes.Delete
            End If
        End With
    Next rngCel
End Sub

Опять же, это прекрасно работает, но удаляет все флажки на листе.

Поэтому я добавил цикл for each в if оператор и попытался указать диапазон:

Sub Remove_chkbx_Unlink_Cell()
    Dim rngCel As Range
    Dim ChkBx As CheckBox

    For Each rngCel In Selection
        With rngCel.MergeArea.Cells
            If .Resize(1, 1).Address = rngCel.Address Then
                For Each ChkBx In rngCel
                    CheckBox.OnAction = ""
                Next ChkBx

                rngCel.CheckBoxes.Delete
            End If
        End With
    Next rngCel
End Sub

Проблема с этим заключается в том, что я получаю и ошибка в строке For Each ChkBx In rngCel:

Несоответствие типов

РЕДАКТИРОВАТЬ

Есть 6 флажков на рисунке ниже, пихта3-я выбрана, а 3 - нет.Есть ли способ удалить непроверенные поля путем выбора ячеек, с которыми они связаны?

Ниже я выбрал ячейки пустых флажков и во многом таким же образом я "создаю"флажки, я хотел бы удалить их: т.е. выберите диапазон ячеек и удалите флажки в этом диапазоне.

enter image description here

1 Ответ

0 голосов
/ 12 октября 2018

Чтобы удалить флажки в определенном диапазоне, вы можете просто перебрать все флажки в листе и удалить их, если их .TopLeftCell пересекается ( Метод Application.Intersect ) с целевым диапазоном.

Option Explicit

Public Sub TestDeleteCheckBoxes()
    'delete all CheckBoxes in A1:A10 in Sheet1
    DeleteCheckBoxes ThisWorkbook.Worksheets("Sheet1").Range("A1:A10")
End Sub

Public Sub DeleteCheckBoxes(Target As Range)
    Dim Cbx As CheckBox
    For Each Cbx In Target.Parent.CheckBoxes 'loop through all CheckBoxes on the worksheet
        If Not Intersect(Cbx.TopLeftCell, Target) Is Nothing Then
            Cbx.Delete 'delete it if it intersects with the target range
        End If
    Next Cbx
End Sub

Примечание. Я включил это в процедуру, чтобы вы могли повторно использовать код в любом целевом диапазоне.

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