Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Назначить один и тот же макрос многим Checkbox-ам
 
#1
03.02.2019 22:03:14
Привет.
У меня есть 30 чекбоксов, по одному в каждой строке.
Как назначить каждому из них один и тот же макрос при снятии флажка?
Макрос вида "если забираю флажок - в соседней ячейке справа от чекбокса очищаются данные"
 
 
 
#2
03.02.2019 22:08:12
Так вот же: http://prntscr.com/mg4cug
Повторить 30 раз.
 
 
 
#3
03.02.2019 22:08:20
Здарова. Можно написать отдельный макрос в стандартном модуле - очистить ячейку справа от заданной.
А потом в каждой процедуре в CheckBox давать ссылку на эту общую процедуру (Call MyMacro, типа того).
Кому решение нужно - тот пример и рисует.
 
 
 
#4
03.02.2019 22:10:11
А можно убрать объекты и использовать события листа. Например, двайной клик по ячейке
 
 
 
#5
03.02.2019 22:12:02
Цитата
Sonnar написал:
Как назначить каждому из них один и тот же макрос при снятии флажка?
если прочитать, то Вы спрашиваете, как назначить какой-то макрос каждому чекбоксу при снятии флажка.
Ну хорошо, я докапываюсь, Вам просто нужно назначить какой то макрос каждому из чекбоксов, который будет обрабатывать только снятие флажка. тогда берете и 30 раз присваиваете этот макрос каждому чекбоксу. Естественно в макросе должна быть соответствующая аналитика что делать.
Изменено: БМВ - 03.02.2019 22:28:10
По вопросам из тем форума, личку не читаю.
 
 
 
#6
03.02.2019 22:17:46
Макрос можете назначить такой:
Код
Sub tt()
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, 1).ClearContents
End Sub

Сорри, тут очищается не глядя на флажок - но это уже не по теме вопроса :)
Изменено: Hugo - 03.02.2019 22:19:16
 
 
 
#7
03.02.2019 22:20:24
Продолжаем ванговать: возможно, требуется макрос, который переберёт все эти 30 контролов и каждому назначит один и тот же макрос ))
Sonnar, уточните задачу.
 
 
 
#8
03.02.2019 22:26:26
Вот эта строка стирает если галку сняли:
Код
If ActiveSheet.Shapes(Application.Caller).DrawingObject.Value <> 1 Then ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, 1).ClearContents

Ну а 30 штук можно задать и вручную это быстрее чем ждать код :)
 
 
 
#9
03.02.2019 22:28:33
Sonnar, макрос для назначения и назначаемый макрос
Код
Sub SetMacro()
Dim x As CheckBox
  For Each x In ActiveSheet.CheckBoxes
    x.OnAction = "So"
  Next
End Sub

Sub So()
Dim x As CheckBox
  Set x = ActiveSheet.CheckBoxes(Application.Caller)
  If x.Value = xlOff Then Range(x.LinkedCell).Offset(, 1).Clear
End Sub
Изменено: Казанский - 03.02.2019 22:33:22
 
 
 
#10
03.02.2019 22:31:44
Алексей, а ведь не факт что LinkedCell будет та, что под чекбоксом...
 
 
 
#11
03.02.2019 22:37:24
Цитата
Юрий М написал:  возможно, требуется макрос, который переберёт все эти 30 контролов и каждому назначит один и тот же макрос ))
Боже, Да!!)) Я сам не смог так точно сформулировать свой же вопрос.
Эти 30 (может 100 или 200) чекбоксов я придумал создавать макросом:
Код
Sub CheckBoxAdd()
Dim cb As CheckBox
Dim myRange As Range, cel As Range
Dim mySheet As Worksheet

Set mySheet = Sheets("Лист1")
Set myRange = mySheet.Range("A2:A30")

For Each cel In myRange

    Set cb = mySheet.CheckBoxes.Add(cel.Left, cel.Top, 30, 6)

      With cb

        .Caption = ""
        .LinkedCell = cel.Address

      End With
Next
End Sub
И совершенно нигде не смог как им всем назначить макрос который делал бы что-то при проставке/снятии флажка.
Изменено: Sonnar - 04.02.2019 00:36:00
 
 
 
#12
03.02.2019 22:41:48
Код
Sub Main()
    Dim S As Shape
    For Each S In ActiveSheet.Shapes
        If S.Name Like "Check*" Then S.OnAction = "Macro1"
    Next
End Sub
 
 
 
#13
03.02.2019 22:43:55
Цитата
Sonnar написал:
нигде не смог как им всем назначить макрос
- тормозите свой код как только появился объект cb и в Locals смотрите что там у него есть.
 
 
 
#14
03.02.2019 22:44:56
Цитата
Hugo написал:
а ведь не факт
да и
Цитата
Казанский написал:
x.Value = xlOff
тоже не сработает. Думаю Казанский, просто случайно ошибся.
Код
If Not Range(x.DrawingObject.LinkedCell) then x.TopLeftCell.Offset(, 1).ClearContents
хотел написать
Но ведь не факт что и LinkedCell определен. По этому  поддержу эту часть Из #8
По вопросам из тем форума, личку не читаю.
 
 
 
#15
03.02.2019 22:46:34
Цитата
Казанский написал: макрос для назначения и назначаемый макрос
Мне кажеться, это то что нужно! Hugo, Юрий М, Спасибо!!

p.s. Боже, сколько ответов! Прямо не ожидал, очень приятно.
 
 
 
#16
03.02.2019 22:46:40
Теперь уже видим что факт :)
И видим что прямо туда и нужно добавить
Код
.OnAction = "So"
 
 
 
#17
03.02.2019 22:49:40
И на всякий случай Macro1 для #12 ))
Код
Sub Macro1()
Dim Rng As Range
    Set Rng = Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address)
    If Rng.Offset(0, 1) = False Then
        Rng = True
        Rng.Offset(0, 1) = Date
    Else
        Rng = False
        Rng.Offset(0, 1) = ""
    End If
End Sub
 
 
 
#18
03.02.2019 22:52:58
Цитата
Hugo написал:
тормозите свой код как только появился объект cb и в Locals смотрите что там у него есть.
Прошу прощения, я только начал учить VBA. Locals Это свойство?
Цитата
БМВ написал:
не факт что и LinkedCell определен
Определен, я сразу в коде их определяю. Правда не до конца понимаю как)
 
 
 
#19
03.02.2019 22:56:06
Цитата
Sonnar написал:
Locals Это свойство?
Это окно в редакторе ))
 
 
 
#20
03.02.2019 22:56:27
Locals - это окно редактора, нужно его отобразить в меню View.
И гоните код пошагово до нужного места (или ставите точку останова или stop)
 
 
 
#21
03.02.2019 23:02:03
Юрий М, Hugo, Простите, не понял сразу.

Спасибо, буду пробовать! Тяжело так сразу, пока не знаешь элементарных вещей)  
 
 
 
Страницы: 1
Наверх