управление флажками (Excel 2003) - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/управление флажками (Excel 2003) - Мир MS Excel

Старая форма входа

Страница 1 из 2 1 2 »
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » управление флажками (Excel 2003) (Макросы/Sub)

управление флажками (Excel 2003)

Дата: Воскресенье, 29.09.2019, 18:15 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 459

Репутация: 6 ±

Замечаний: 0% ±

2003

Доброго времени суток.
Похоже я не там писал тему по макросам в VBA.
Окажите помощь в написании макроса для управления флажками.
Просто я не знаю что в них нужно прописывать.
С одним флажком bmv98rus мне помог.
Нужно смешанное управление, т.е.
флажки 6-15 включаются индивидуально
при включении флажка 3, включаются флажки 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
при включении флажка 4, включаются флажки 7, 9, 11
при включении флажка 5, включаются флажки 8, 10, 12
при включении флажков 7, 9, 11 включается флажок 4
при включении флажков 8, 10, 12 включается флажок 5

Подскажите где можно найти инфу по написанию макросов для флажков, желательно на русском. Заранее благодарен.

К сообщению приложен файл: 5667367.xls (39.5 Kb)

Ответить

Дата: Воскресенье, 29.09.2019, 19:52 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4106

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

[vba]

Код

Sub CheckBoxClic()
With ActiveSheet.Shapes(Application.Caller).DrawingObject
    Select Case Application.Caller
    Case "Check Box 1"

    Case "Check Box 2"
        If ActiveSheet.Shapes("Check Box 1").DrawingObject.Value <> 1 Then _
            .Value = False

    Case "Check Box 3"
        If .Value <> 1 Then
            For i = 4 To 15
                ActiveSheet.Shapes("Check Box " & i).DrawingObject.Value = .Value
            Next
        End If

    Case "Check Box 4"
        If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
            .Value = False
        If .Value <> 1 Then
            For i = 7 To 11 Step 2
                ActiveSheet.Shapes("Check Box " & i).DrawingObject.Value = False
            Next
        End If

    Case "Check Box 5"
        If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
            .Value = False
        If .Value <> 1 Then
            For i = 8 To 12 Step 2
                ActiveSheet.Shapes("Check Box " & i).DrawingObject.Value = False
            Next
        End If

     Case "Check Box 6", "Check Box 13", "Check Box 14", "Check Box 15"
       If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
            .Value = False
    Case "Check Box 7", "Check Box 9", "Check Box 11"
        If ActiveSheet.Shapes("Check Box 4").DrawingObject.Value <> 1 Then _
            .Value = False
    Case "Check Box 8", "Check Box 10", "Check Box 12"
        If ActiveSheet.Shapes("Check Box 5").DrawingObject.Value <> 1 Then _
                .Value = False
    End Select
End With

End Sub

[/vba]

К сообщению приложен файл: Copy_of_1156.xlsm (26.2 Kb)

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Ответить

Сообщение[vba]

Код

Sub CheckBoxClic()
With ActiveSheet.Shapes(Application.Caller).DrawingObject
    Select Case Application.Caller
    Case "Check Box 1"

    Case "Check Box 2"
        If ActiveSheet.Shapes("Check Box 1").DrawingObject.Value <> 1 Then _
            .Value = False

    Case "Check Box 3"
        If .Value <> 1 Then
            For i = 4 To 15
                ActiveSheet.Shapes("Check Box " & i).DrawingObject.Value = .Value
            Next
        End If

    Case "Check Box 4"
        If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
            .Value = False
        If .Value <> 1 Then
            For i = 7 To 11 Step 2
                ActiveSheet.Shapes("Check Box " & i).DrawingObject.Value = False
            Next
        End If

    Case "Check Box 5"
        If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
            .Value = False
        If .Value <> 1 Then
            For i = 8 To 12 Step 2
                ActiveSheet.Shapes("Check Box " & i).DrawingObject.Value = False
            Next
        End If

     Case "Check Box 6", "Check Box 13", "Check Box 14", "Check Box 15"
       If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
            .Value = False
    Case "Check Box 7", "Check Box 9", "Check Box 11"
        If ActiveSheet.Shapes("Check Box 4").DrawingObject.Value <> 1 Then _
            .Value = False
    Case "Check Box 8", "Check Box 10", "Check Box 12"
        If ActiveSheet.Shapes("Check Box 5").DrawingObject.Value <> 1 Then _
                .Value = False
    End Select
End With

End Sub

[/vba]

Автор - bmv98rus
Дата добавления - 29.09.2019 в 19:52

Дата: Воскресенье, 29.09.2019, 20:46 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 459

Репутация: 6 ±

Замечаний: 0% ±

2003

bmv98rus, Попытки получить результат, успехом не увенчались.

Ошибка (???) со второй строчки
[vba]

Код

With ActiveSheet.Shapes(Application.Caller).DrawingObject

[/vba]
Вроде и макрос назначил. Может не туда куда следует? Можно ли порядок действий с макросом по подробнее?
У меня Excel 2003! Там макрос должен работать?

Сообщение отредактировал Gold_Barsik - Воскресенье, 29.09.2019, 21:07

Ответить

Дата: Воскресенье, 29.09.2019, 21:24 | Сообщение № 4

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4106

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

Цитата Gold_Barsik, 29.09.2019 в 20:46, в сообщении № 3 ()

У меня Excel 2003! Там макрос должен работать?

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

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Ответить

Дата: Воскресенье, 29.09.2019, 22:43 | Сообщение № 5

Группа: Проверенные

Ранг: Обитатель

Сообщений: 459

Репутация: 6 ±

Замечаний: 0% ±

2003

[vba]

Код

Нужно ли это

[/vba]
Конечно, даже очень нужно (мне)!

Ответить

Дата: Понедельник, 30.09.2019, 08:53 | Сообщение № 6

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Я только в пятницу с аналогичным вопросом обращался и сам же ответил:
к флажкам из элементов управления формы можно обращаться как к элементам коллекции CheckBoxes
Например:
[vba]

Код

Sub ttt()
Debug.Print Me.CheckBoxes("FLAG").Value
End Sub

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Понедельник, 30.09.2019, 08:56 | Сообщение № 7

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Цитата bmv98rus, 29.09.2019 в 21:24, в сообщении № 4 ()

Уппс, да, я про это забыл.

Позвольте полюбопытствовать, что из этого кода отсутствует в 2003?

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Понедельник, 30.09.2019, 09:00 | Сообщение № 8

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

RAN, я пока писал ответ, забыл, что хотел задать тот же вопрос.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Понедельник, 30.09.2019, 09:17 | Сообщение № 9

Группа: Проверенные

Ранг: Обитатель

Сообщений: 459

Репутация: 6 ±

Замечаний: 0% ±

2003

Alex_ST, Что то такое же [vba]

Код

к элементам коллекции CheckBoxes

[/vba] я где то читал. Но что это ни черта не понял. Да ещё и вопрос Вы там закрыли, не раскрыв подробностей

.
RAN, [vba]

Код

полюбопытствовать

[/vba] извольте yes

yes

:'(

, например у меня ни в 2003, ни 2007 ничего не сработало :'(

:'(

. А чего там отсутствует так я не берусь судить. Всё равно ни черта не понимаю

. Но так сильно хочется (иметь рабочий файл)

!

Ответить

Дата: Понедельник, 30.09.2019, 10:04 | Сообщение № 10

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Цитата Gold_Barsik, 30.09.2019 в 09:17, в сообщении № 9 ()

Да ещё и вопрос Вы там закрыли, не раскрыв подробностей

Как это не раскрыв подробностей? Вопрос был:

Цитата Alex_ST, 27.09.2019 в 11:29, в сообщении № 1 ()

как узнать состояние элемента управления форм "Флажок", размещенного на листе, но не привязанного ни к одной ячейке?

И ответ на него как раз с примером как это сделать:

Цитата Alex_ST, 27.09.2019 в 11:48, в сообщении № 2 ()

Нашёл как сделать через обращение к элементу коллекции CheckBoxes
Например, на листе создан чек-бокс FLAG
Тогда обратиться к его значению можно так:
[vba]

Код

Sub ttt()
Debug.Print Me.CheckBoxes("FLAG").Value
End Sub

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Понедельник, 30.09.2019, 14:05 | Сообщение № 11

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4106

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

Alex_ST, Можете проверить мой код на 2003? У меня подозрения и на Application.Caller и на .DrawingObject . Больше склонен а каллеру которого нет в 2003. и возможно в 2007
Локализация - это вред!!!

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Сообщение отредактировал bmv98rus - Понедельник, 30.09.2019, 17:28

Ответить

Дата: Понедельник, 30.09.2019, 14:52 | Сообщение № 12

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Итого
Неча на 2003 пенять, коли макрос кривой.

В файле из №2 Application.Caller дает только "Check Box 1" и "Check Box 2", все остальные - "Флажок №".
Для трех флажков поправил (все лень)
[vba]

Код

Sub CheckBoxClic()
    With ActiveSheet
        xx = .CheckBoxes(Application.Caller).Name

        Select Case xx
'        Case "Check Box 1"
'
'        Case "Check Box 2"
'            If ActiveSheet.Shapes("Check Box 1").DrawingObject.Value <> 1 Then _
'               .Value = False

        Case "Check Box 3"
            ar = Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next

        Case "Check Box 4"
            ar = Array(7, 9, 11)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next

        Case "Check Box 5"
            ar = Array(8, 10, 12)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next
'        Case "Check Box 6", "Check Box 13", "Check Box 14", "Check Box 15"
'            If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
'               .Value = False
'        Case "Check Box 7", "Check Box 9", "Check Box 11"
'            If ActiveSheet.Shapes("Check Box 4").DrawingObject.Value <> 1 Then _
'               .Value = False
'        Case "Check Box 8", "Check Box 10", "Check Box 12"
'            If ActiveSheet.Shapes("Check Box 5").DrawingObject.Value <> 1 Then _
'               .Value = False
        End Select
    End With

End Sub

[/vba]

Итого
Неча на 2003 пенять, коли макрос кривой.

В файле из №2 Application.Caller дает только "Check Box 1" и "Check Box 2", все остальные - "Флажок №".
Для трех флажков поправил (все лень)
[vba]

Код

Sub CheckBoxClic()
    With ActiveSheet
        xx = .CheckBoxes(Application.Caller).Name

        Select Case xx
'        Case "Check Box 1"
'
'        Case "Check Box 2"
'            If ActiveSheet.Shapes("Check Box 1").DrawingObject.Value <> 1 Then _
'               .Value = False

        Case "Check Box 3"
            ar = Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next

        Case "Check Box 4"
            ar = Array(7, 9, 11)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next

        Case "Check Box 5"
            ar = Array(8, 10, 12)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next
'        Case "Check Box 6", "Check Box 13", "Check Box 14", "Check Box 15"
'            If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
'               .Value = False
'        Case "Check Box 7", "Check Box 9", "Check Box 11"
'            If ActiveSheet.Shapes("Check Box 4").DrawingObject.Value <> 1 Then _
'               .Value = False
'        Case "Check Box 8", "Check Box 10", "Check Box 12"
'            If ActiveSheet.Shapes("Check Box 5").DrawingObject.Value <> 1 Then _
'               .Value = False
        End Select
    End With

End Sub

[/vba]RAN

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Понедельник, 30.09.2019, 14:52

Ответить

СообщениеИтого
Неча на 2003 пенять, коли макрос кривой.

В файле из №2 Application.Caller дает только "Check Box 1" и "Check Box 2", все остальные - "Флажок №".
Для трех флажков поправил (все лень)
[vba]

Код

Sub CheckBoxClic()
    With ActiveSheet
        xx = .CheckBoxes(Application.Caller).Name

        Select Case xx
'        Case "Check Box 1"
'
'        Case "Check Box 2"
'            If ActiveSheet.Shapes("Check Box 1").DrawingObject.Value <> 1 Then _
'               .Value = False

        Case "Check Box 3"
            ar = Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next

        Case "Check Box 4"
            ar = Array(7, 9, 11)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next

        Case "Check Box 5"
            ar = Array(8, 10, 12)
            For Each ch In .CheckBoxes
                For i = 0 To UBound(ar)
                    If Val(Mid(ch.Name, InStrRev(ch.Name, " "))) = ar(i) Then
                        ch.Value = .CheckBoxes(Application.Caller).Value
                    End If
                Next
            Next
'        Case "Check Box 6", "Check Box 13", "Check Box 14", "Check Box 15"
'            If ActiveSheet.Shapes("Check Box 3").DrawingObject.Value <> 1 Then _
'               .Value = False
'        Case "Check Box 7", "Check Box 9", "Check Box 11"
'            If ActiveSheet.Shapes("Check Box 4").DrawingObject.Value <> 1 Then _
'               .Value = False
'        Case "Check Box 8", "Check Box 10", "Check Box 12"
'            If ActiveSheet.Shapes("Check Box 5").DrawingObject.Value <> 1 Then _
'               .Value = False
        End Select
    End With

End Sub

[/vba]

Автор - RAN
Дата добавления - 30.09.2019 в 14:52

Дата: Понедельник, 30.09.2019, 15:09 | Сообщение № 13

Группа: Проверенные

Ранг: Ветеран

Сообщений: 711

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

RAN А макрос должен срабатывать при изменении состояния любого флажка?
Где должен находиться макрос: в модуле листа или в стандартном модуле?

Ответить

Дата: Понедельник, 30.09.2019, 15:27 | Сообщение № 14

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4106

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

Цитата RAN, 30.09.2019 в 14:52, в сообщении № 12 ()

Итого
Неча на 2003 пенять, коли макрос кривой.

Андрей, как говорит Тезка ваш - где ваши доказательства? Хотя очень может быть что локализация опять шутит. У меня все в 2016 и в 2013 все работает, но натыкался , когда различалось имя в RU и ENG интерфейсах, при этом файл тот же был.

К сообщению приложен файл: 1780937.jpg (15.5 Kb)

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Сообщение отредактировал bmv98rus - Понедельник, 30.09.2019, 17:27

Ответить

Дата: Понедельник, 30.09.2019, 16:33 | Сообщение № 15

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Усы, лапы, хвост. Вот наши доказательства. yes

yes

[p.s.]И это уже с другого компа[/p.s.]

Kuzmich, в стандартном. И всем флажкам назначается один макрос.

К сообщению приложен файл: 0788385.jpg (15.4 Kb) · 2579279.jpg (30.0 Kb)

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Понедельник, 30.09.2019, 17:03

Ответить

Дата: Понедельник, 30.09.2019, 17:27 | Сообщение № 16

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4106

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

Цитата RAN, 30.09.2019 в 16:33, в сообщении № 15 ()

И это уже с другого компа

ну точно, первые два я переименовывал сам, в исходном были поменяны местами, вот и результат, у меня все ENG, а у локализованном варианте ….

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Ответить

Дата: Вторник, 01.10.2019, 08:46 | Сообщение № 17

Группа: Проверенные

Ранг: Обитатель

Сообщений: 459

Репутация: 6 ±

Замечаний: 0% ±

2003

Почему не получается применить макрос?
Вроде модуль есть, вроде макрос туда вписал, вроде назначил макрос каждому флажку. А на выходе "0".
Третью строку выделяет жёлтым цветом.

Открывал вложенный файл - работает. Прописал в него новые исправления - работает. Пере сохранил его в 2003 - работает. А в действующем - не работает.

Ну не переносить же мне содержимое действующего файла в копию????

bmv98rus, А как быть с первым и вторым флагом, они что-то в ново-исправленном макросе не работают

входит в ступор при включении флажка 1 на восьмой строчке.

Сообщение отредактировал Gold_Barsik - Вторник, 01.10.2019, 09:20

Ответить

Дата: Вторник, 01.10.2019, 09:06 | Сообщение № 18

Группа: Проверенные

Ранг: Обитатель

Сообщений: 459

Репутация: 6 ±

Замечаний: 0% ±

2003

RAN, Вы пробовали замороженный хлеб? Это когда пекарня состряпала хлеб и решила с экономить на топливных ресурсах. Мол покупателю останется его разогреть минуток 20, ну а там что получится. Как говорится что бог пошлёт.
Это я к тому что мне с ним делать? С макросом. Знать бы что туда ещё необходимо прописать. Я бы в пекари пошёл, пусть меня научат.

Сообщение отредактировал Gold_Barsik - Вторник, 01.10.2019, 09:09

Ответить

Дата: Вторник, 01.10.2019, 10:43 | Сообщение № 19

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4106

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

Цитата Gold_Barsik, 01.10.2019 в 08:46, в сообщении № 17 ()

они что-то в ново-исправленном макросе не работают входит в ступор при включении флажка 1 на восьмой строчке.

так это уже не мой скрипт.

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Ответить

Дата: Вторник, 01.10.2019, 11:08 | Сообщение № 20

Группа: Проверенные

Ранг: Обитатель

Сообщений: 459

Репутация: 6 ±

Замечаний: 0% ±

2003

bmv98rus, Это я и так понимаю.

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » управление флажками (Excel 2003) (Макросы/Sub)

Страница 1 из 2
1
2
»

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!