Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
VBA добавить чек-бокс на лист и сохранить его значение в массив
 
Здравствуйте,

Может ли кто помочь с такой не хитрой задачей: из модуля хочу добавить на лист (с привязкой к ячейке) чек-бокс и далее читать его состояние (true/false) и сохранять в массив.

И что лучше выбрать Формы или ActiveX тоже не понимаю, хоть и гуглил. Не доходит до меня...

Демо-файлик прикрепил.

Заранее, благодарю.
 
prostor,

Код
'Добавить чек-бокс
Sub ActiveAdd()
    Dim chBox As Object
    For Each el In Range([A2], [A2].End(xlDown))
        Set chBox = ActiveSheet.CheckBoxes.Add(el.Offset(0, 2).Left, el.Offset(0, 2).Top, el.Offset(0, 2).Width, el.Offset(0, 2).Height)
        chBox.LinkedCell = el.Offset(0, 3).Address(True, True)
    Next el
End Sub
' Удалить чек-бокс
Sub ActiveDelete()
    Dim chBox As Object
    For Each el In ActiveSheet.CheckBoxes
        el.Delete
    Next el
End Sub

'Снять показания чек-боксов и записать в массив
    Sub ActiveRead()
        Dim myArray As Variant
        myArray = Application.Transpose(Range([D2], [D2].End(xlDown)).Value)        
        For i = 1 To UBound(myArray)
            MsgBox i & " = " & myArray(i)
        Next i
    End Sub
 
tolstak, спасибо, все сработало.

Маленький нюансик остался - как снимать показания именно с чек-бокса, без участия колонки D ? Ну и добавлять в нее тоже ничего не надо, соответственно :)
---
Разобрался только, что эта строка добавляет показание чек-бокса - закоментировал ее...
Код
chBox.LinkedCell = el.Offset(0, 3).Address(True, True)

А вот как теперь снять показание с самого чек-бокса - разобраться не могу....
Изменено: prostor - 11 Авг 2017 19:34:35
 
prostor, тогда чуть усложняем словарем и такой-то матерью)
Код
Public chkBoxDic As Object

'Добавить чек-бокс
Sub ActiveAdd()
    ActiveDelete
    Set chkBoxDic = CreateObject("Scripting.Dictionary")
    Dim chBox As Object
    For Each el In Range([A2], [A2].End(xlDown))
        Set chBox = ActiveSheet.CheckBoxes.Add(el.Offset(0, 2).Left, el.Offset(0, 2).Top, el.Offset(0, 2).Width, el.Offset(0, 2).Height)
        'chBox.LinkedCell = el.Offset(0, 3).Address(True, True)
        chBox.Caption = el.Value
        chBox.Name = el.Value
        Set chkBoxDic(chBox.Name) = chBox
    Next el
End Sub
' Удалить чек-боксы
Sub ActiveDelete()
    Dim chBox As Object
    If Not chkBoxDic Is Nothing Then Set chkBoxDic = Nothing
        For Each el In ActiveSheet.CheckBoxes
            el.Delete
        Next el
End Sub
 
' Снять показания чек-бокса без обращения к ячейкам
Sub readDictionary()
    If chkBoxDic Is Nothing Then Exit Sub
    Dim el As Object
    For i = 0 To chkBoxDic.Count - 1
        Set el = chkBoxDic.Items()(i)
        MsgBox i & ": " & chkBoxDic.Keys()(i) & " = " & IIf(el.Value = -4146, False, True)
    Next i
End Sub

'Снять показания чек-боксов и записать в массив
Sub ActiveRead()
    myArray = Application.Transpose(Range([D2], [D2].End(xlDown)).Value)
    For i = 1 To UBound(myArray)
        MsgBox i & " = " & myArray(i)
    Next i
End Sub

Я не понимаю почему, но значение при отмеченной галке - 1, а при не выбранной - -4146 , но преобразование типа  
Код
IIf(a.Value = -4146, False, True)
работает. Тут вот тот же вопрос проскакивал.
Может, более опытные товарищи подскажут почему так.
 
tolstak, огромное спасибо! все работает.

По поводу -4146, думаю не проблема. это значение вроде как постоянное, значит с ним можно работать. верно понимаю?:)
 
prostor, да, так и есть. Просто непонятная какая-то константа... :)
 
tolstak, Приветствую:)

Допиливаю ваш пример под себя и столкнулся с такой сложностью: хочу использовать ActiveAdd как процедуру с параметрами, вызывать из другого модуля, но не могу сообразить как правильно организовать вызов, с использованием цикла
Код
For Each el In Range([A2], [A2].End(xlDown)) ...

Прошу вашей помощи по этому поводу:) Файл приложил...

Заранее, благодарю.
 
prostor,  посмотрите в файле. Вероятно, что i и j - строка и столбец, изменил процедуру соответствующим образом. Работает,но сложилось ощущение, что вставляется не совсем так как Вами задумывалось :)
Изменено: tolstak - 16 Авг 2017 20:19:47
 
tolstak, спасибо, все как надо, чуток подправил под себя

По ходу дела, возникла такая ситуация, что после закрытия файла и повторного открытия - считать показания чек-боксов нельзя. При этом сам excel сохраняет галочки на чек-боксах, а значит оно в прицепи где-то есть в самом файле excel, на диске...

Я понимаю, что идет чтение из словаря, пока он живой. Но интересно, как то ведь можно снимать показания с чек-боксов после "закрыл-открыл файл"?

Прикладываю файлик..
 
prostor, у Вас красивая логика присвоения имен чек-боксам.
Можно просто обратиться к ним по этим красивым именам.
Можно даже и без словаря обойтись в таком случае, ну да пусть будет :)
Код
Sub readDictionary()
    If chkBoxDic Is Nothing Then
        ' Еще побарахтаемся!
        'Exit Sub
        
        Dim j As Long, i As Long, cbClient As String, cbCaption As String, dicItem As String
        Set chkBoxDic = CreateObject("Scripting.Dictionary")
        'Перейти на новую строку
        For j = 2 To 18 'Цикл шага вниз, не менять. В рабочей версии - шаг динамический.
            cbClient = Cells(j, 1)
            For i = 5 To 7
                
                Select Case i
                Case 5
                cbCaption = "Да"
                Case 6
                cbCaption = "Нет"
                Case 7
                cbCaption = "Неизвестно"
                End Select
                
                dicItem = cbClient & ":" & cbCaption
                chkBoxDic.Add Key:=dicItem, Item:=ActiveSheet.CheckBoxes(dicItem)
            Next i
            j = j + 3
        Next j
    End If
    
    
    Dim el As Object
    
    
    For i = 0 To chkBoxDic.Count - 1
        Set el = chkBoxDic.Items()(i)
        MsgBox chkBoxDic.Keys()(i) & ":" & IIf(el.Value = -4146, False, True)
    Next i
End Sub
Страницы: 1
Читают тему (гостей: 1)