Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 2 из 2
  • «
  • 1
  • 2
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » управление флажками (Excel 2003) (Макросы/Sub)
управление флажками (Excel 2003)
RAN Дата: Вторник, 01.10.2019, 11:11 | Сообщение № 21
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Знать бы что туда ещё необходимо прописать

А кто это знать должен? Я не экстрасенс.
Дописал в соответствии с описанием требуемых действий, заодно и лишнее убрал.
[vba]
Код
Sub CheckBoxClic()
    xx = ActiveSheet.CheckBoxes(Application.Caller).Name
    GoSub Check_
    Exit Sub
Check_:
    With ActiveSheet
        Select Case xx
        Case "Check Box 1"
            .CheckBoxes("Check Box 2").Value = .CheckBoxes("Check Box 1").Value
        Case "Check Box 3"
            If .CheckBoxes(xx) = 1 Then
                ar = Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
                For i = 0 To UBound(ar)
                    .CheckBoxes("Check Box " & ar(i)).Value = 1
                Next
            End If
        Case "Check Box 4"
            a = .CheckBoxes(xx).Value
            If .CheckBoxes(xx) = 1 Then
                ar = Array(7, 9, 11)
                For i = 0 To UBound(ar)
                    .CheckBoxes("Check Box " & ar(i)).Value = 1
                Next
            End If
        Case "Check Box 5"
            If .CheckBoxes(xx) = 1 Then
                ar = Array(8, 10, 12)
                For i = 0 To UBound(ar)
                    .CheckBoxes("Check Box " & ar(i)).Value = 1
                Next
            End If
        Case "Check Box 7", "Check Box 9", "Check Box 11"
            ar = Array(7, 9, 11)
            If .CheckBoxes("Check Box " & ar(0)) = 1 And .CheckBoxes("Check Box " & ar(1)) = 1 And .CheckBoxes("Check Box " & ar(2)) = 1 Then
                .CheckBoxes("Check Box 4") = 1
                xx = "Check Box 4"
                GoSub Check_
            End If
        Case "Check Box 8", "Check Box 10", "Check Box 12"
            ar = Array(8, 10, 12)
            If .CheckBoxes("Check Box " & ar(0)) = 1 And .CheckBoxes("Check Box " & ar(1)) = 1 And .CheckBoxes("Check Box " & ar(2)) = 1 Then
                .CheckBoxes("Check Box 5") = 1
                xx = "Check Box 5"
                GoSub Check_
            End If
        End Select
    End With
    Return
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Знать бы что туда ещё необходимо прописать

А кто это знать должен? Я не экстрасенс.
Дописал в соответствии с описанием требуемых действий, заодно и лишнее убрал.
[vba]
Код
Sub CheckBoxClic()
    xx = ActiveSheet.CheckBoxes(Application.Caller).Name
    GoSub Check_
    Exit Sub
Check_:
    With ActiveSheet
        Select Case xx
        Case "Check Box 1"
            .CheckBoxes("Check Box 2").Value = .CheckBoxes("Check Box 1").Value
        Case "Check Box 3"
            If .CheckBoxes(xx) = 1 Then
                ar = Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
                For i = 0 To UBound(ar)
                    .CheckBoxes("Check Box " & ar(i)).Value = 1
                Next
            End If
        Case "Check Box 4"
            a = .CheckBoxes(xx).Value
            If .CheckBoxes(xx) = 1 Then
                ar = Array(7, 9, 11)
                For i = 0 To UBound(ar)
                    .CheckBoxes("Check Box " & ar(i)).Value = 1
                Next
            End If
        Case "Check Box 5"
            If .CheckBoxes(xx) = 1 Then
                ar = Array(8, 10, 12)
                For i = 0 To UBound(ar)
                    .CheckBoxes("Check Box " & ar(i)).Value = 1
                Next
            End If
        Case "Check Box 7", "Check Box 9", "Check Box 11"
            ar = Array(7, 9, 11)
            If .CheckBoxes("Check Box " & ar(0)) = 1 And .CheckBoxes("Check Box " & ar(1)) = 1 And .CheckBoxes("Check Box " & ar(2)) = 1 Then
                .CheckBoxes("Check Box 4") = 1
                xx = "Check Box 4"
                GoSub Check_
            End If
        Case "Check Box 8", "Check Box 10", "Check Box 12"
            ar = Array(8, 10, 12)
            If .CheckBoxes("Check Box " & ar(0)) = 1 And .CheckBoxes("Check Box " & ar(1)) = 1 And .CheckBoxes("Check Box " & ar(2)) = 1 Then
                .CheckBoxes("Check Box 5") = 1
                xx = "Check Box 5"
                GoSub Check_
            End If
        End Select
    End With
    Return
End Sub
[/vba]

Автор - RAN
Дата добавления - 01.10.2019 в 11:11
Gold_Barsik Дата: Вторник, 01.10.2019, 13:55 | Сообщение № 22
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
За это БОЛЬШОЕ ВАМ СПАСИБО!!
 
Ответить
СообщениеЗа это БОЛЬШОЕ ВАМ СПАСИБО!!

Автор - Gold_Barsik
Дата добавления - 01.10.2019 в 13:55
Gold_Barsik Дата: Вторник, 01.10.2019, 17:56 | Сообщение № 23
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
RAN, Что то Вы накосячили <_< >( %)
В предыдущем хоть три флага работало, а сейчас ваще пипец. :o :'(


Сообщение отредактировал Gold_Barsik - Вторник, 01.10.2019, 17:58
 
Ответить
СообщениеRAN, Что то Вы накосячили <_< >( %)
В предыдущем хоть три флага работало, а сейчас ваще пипец. :o :'(

Автор - Gold_Barsik
Дата добавления - 01.10.2019 в 17:56
RAN Дата: Вторник, 01.10.2019, 18:34 | Сообщение № 24
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Я накосячил? :o

В предыдущем хоть три флага работало

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

а сейчас ваще пипец.

Если вы думаете одно, а пишете другое, при чем тут я?
Обращение к CheckBox у вас есть, а условия и действия можете переписывать по своему разумению.

[p.s.]К пуговицам претензии есть?[/p.s.]


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

Сообщение отредактировал RAN - Вторник, 01.10.2019, 18:41
 
Ответить
СообщениеЯ накосячил? :o

В предыдущем хоть три флага работало

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

а сейчас ваще пипец.

Если вы думаете одно, а пишете другое, при чем тут я?
Обращение к CheckBox у вас есть, а условия и действия можете переписывать по своему разумению.

[p.s.]К пуговицам претензии есть?[/p.s.]

Автор - RAN
Дата добавления - 01.10.2019 в 18:34
bmv98rus Дата: Вторник, 01.10.2019, 20:10 | Сообщение № 25
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4098
Репутация: 766 ±
Замечаний: 0% ±

Excel 2013/2016
Ох уж эти форумные коты, ... :-)
Мне понравился рекурсивный вариант, но дыбы просто скорректировать то что вроде как не работало
[vba]
Код

Sub CheckBoxClic()
CB = ActiveSheet.Shapes(Application.Caller).Name

With ActiveSheet.CheckBoxes(CB)
    Select Case CB
    Case "Check Box 1"
    Case "Check Box 2"
        If ActiveSheet.CheckBoxes("Check Box 1").Value <> 1 Then _
            .Value = False
    Case "Check Box 3"
        If .Value <> 1 Then
            For Each i In Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
                ActiveSheet.CheckBoxes("Check Box " & i).Value = .Value
            Next
        End If
    Case "Check Box 4"
        If ActiveSheet.CheckBoxes("Check Box 3").Value <> 1 Then _
            .Value = False
        If .Value <> 1 Then
            For Each i In Array(7, 9, 11)
                ActiveSheet.CheckBoxes("Check Box " & i).Value = False
            Next
        End If
    Case "Check Box 5"
        If ActiveSheet.CheckBoxes("Check Box 3").Value <> 1 Then _
            .Value = False
        If .Value <> 1 Then
            For Each i In Array(8, 10, 12)
                ActiveSheet.CheckBoxes("Check Box " & i).DrawingObject.Value = False
            Next
        End If
        
     Case "Check Box 6", "Check Box 13", "Check Box 14", "Check Box 15"
       If ActiveSheet.CheckBoxes("Check Box 3").Value <> 1 Then _
            .Value = False
    Case "Check Box 7", "Check Box 9", "Check Box 11"
        If ActiveSheet.CheckBoxes("Check Box 4").Value <> 1 Then _
            .Value = False
    Case "Check Box 8", "Check Box 10", "Check Box 12"
        If ActiveSheet.CheckBoxes("Check Box 5").Value <> 1 Then _
                .Value = False
    End Select
End With
[/vba]
К сообщению приложен файл: Copy_of_Copy_of.xlsm (26.9 Kb)


Замечательный Временно просто медведь , процентов на 20.
 
Ответить
СообщениеОх уж эти форумные коты, ... :-)
Мне понравился рекурсивный вариант, но дыбы просто скорректировать то что вроде как не работало
[vba]
Код

Sub CheckBoxClic()
CB = ActiveSheet.Shapes(Application.Caller).Name

With ActiveSheet.CheckBoxes(CB)
    Select Case CB
    Case "Check Box 1"
    Case "Check Box 2"
        If ActiveSheet.CheckBoxes("Check Box 1").Value <> 1 Then _
            .Value = False
    Case "Check Box 3"
        If .Value <> 1 Then
            For Each i In Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)
                ActiveSheet.CheckBoxes("Check Box " & i).Value = .Value
            Next
        End If
    Case "Check Box 4"
        If ActiveSheet.CheckBoxes("Check Box 3").Value <> 1 Then _
            .Value = False
        If .Value <> 1 Then
            For Each i In Array(7, 9, 11)
                ActiveSheet.CheckBoxes("Check Box " & i).Value = False
            Next
        End If
    Case "Check Box 5"
        If ActiveSheet.CheckBoxes("Check Box 3").Value <> 1 Then _
            .Value = False
        If .Value <> 1 Then
            For Each i In Array(8, 10, 12)
                ActiveSheet.CheckBoxes("Check Box " & i).DrawingObject.Value = False
            Next
        End If
        
     Case "Check Box 6", "Check Box 13", "Check Box 14", "Check Box 15"
       If ActiveSheet.CheckBoxes("Check Box 3").Value <> 1 Then _
            .Value = False
    Case "Check Box 7", "Check Box 9", "Check Box 11"
        If ActiveSheet.CheckBoxes("Check Box 4").Value <> 1 Then _
            .Value = False
    Case "Check Box 8", "Check Box 10", "Check Box 12"
        If ActiveSheet.CheckBoxes("Check Box 5").Value <> 1 Then _
                .Value = False
    End Select
End With
[/vba]

Автор - bmv98rus
Дата добавления - 01.10.2019 в 20:10
RAN Дата: Вторник, 01.10.2019, 21:00 | Сообщение № 26
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Миша, ты плохо читаешь. И принимаешь написанное за то, что, вероятно, должно было быть написано.
при включении флажка 3, включаются флажки 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15

Где сказано, что нужно выполнять обратное действие?
Рекурсия была сделана для условия
[vba]
Код
If .CheckBoxes(xx) = 1 Then
[/vba]
Изменение условия на
[vba]
Код
If .CheckBoxes("Check Box " & ar(0)) = 1 And .CheckBoxes("Check Box " & ar(1)) = 1 And .CheckBoxes("Check Box " & ar(2)) = 1 Then
[/vba]
сделало рекурсию бессмысленной, забыл убрать, хотя там, вероятно, есть с чем поиграться.

PS А уж что должно быть тут
[vba]
Код
Case "Check Box 7", "Check Box 9", "Check Box 11"
[/vba]
вообще тайга.


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

Сообщение отредактировал RAN - Вторник, 01.10.2019, 21:13
 
Ответить
СообщениеМиша, ты плохо читаешь. И принимаешь написанное за то, что, вероятно, должно было быть написано.
при включении флажка 3, включаются флажки 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15

Где сказано, что нужно выполнять обратное действие?
Рекурсия была сделана для условия
[vba]
Код
If .CheckBoxes(xx) = 1 Then
[/vba]
Изменение условия на
[vba]
Код
If .CheckBoxes("Check Box " & ar(0)) = 1 And .CheckBoxes("Check Box " & ar(1)) = 1 And .CheckBoxes("Check Box " & ar(2)) = 1 Then
[/vba]
сделало рекурсию бессмысленной, забыл убрать, хотя там, вероятно, есть с чем поиграться.

PS А уж что должно быть тут
[vba]
Код
Case "Check Box 7", "Check Box 9", "Check Box 11"
[/vba]
вообще тайга.

Автор - RAN
Дата добавления - 01.10.2019 в 21:00
bmv98rus Дата: Вторник, 01.10.2019, 21:17 | Сообщение № 27
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4098
Репутация: 766 ±
Замечаний: 0% ±

Excel 2013/2016
Анlрей, ну смайл то не зря стоит. Я все нормально прочел. Если б не читал правильно то и обиду б на кривой код затаил :-)

Gold_Barsik, на самом деле Ваше "при включении флажка 3, включаются флажки 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15" можно толковать по разному. Я понял как активирует и соответвенно при снятии флага производится очищение указанных Это исходя из связи первого и второго. Но можно и по другому понять, что при установке этого флага, все указнные тоже устанавливаются CheckAll.
Что нужно - хз. в одном я солидарен с RAN, Вам нарисовали варианту, с которыми вы можете самостоятельно построить логику, которую хотите. Я вот даже вернулся к массиву с перечислением, хотя поначалу отказался в сторону цикла, но этот вариант позволяет более гибко делать перечисления.


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

Сообщение отредактировал bmv98rus - Вторник, 01.10.2019, 22:15
 
Ответить
СообщениеАнlрей, ну смайл то не зря стоит. Я все нормально прочел. Если б не читал правильно то и обиду б на кривой код затаил :-)

Gold_Barsik, на самом деле Ваше "при включении флажка 3, включаются флажки 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15" можно толковать по разному. Я понял как активирует и соответвенно при снятии флага производится очищение указанных Это исходя из связи первого и второго. Но можно и по другому понять, что при установке этого флага, все указнные тоже устанавливаются CheckAll.
Что нужно - хз. в одном я солидарен с RAN, Вам нарисовали варианту, с которыми вы можете самостоятельно построить логику, которую хотите. Я вот даже вернулся к массиву с перечислением, хотя поначалу отказался в сторону цикла, но этот вариант позволяет более гибко делать перечисления.

Автор - bmv98rus
Дата добавления - 01.10.2019 в 21:17
RAN Дата: Вторник, 01.10.2019, 21:25 | Сообщение № 28
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
.


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

Сообщение отредактировал RAN - Вторник, 01.10.2019, 21:47
 
Ответить
Сообщение.

Автор - RAN
Дата добавления - 01.10.2019 в 21:25
Gold_Barsik Дата: Вторник, 01.10.2019, 23:28 | Сообщение № 29
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
Огромная благодарность и Вам bmv98rus, и Вам RAN, ну что с нас взять? Вот такие мы Обитатели.

RAN, [vba]
Код
сначала я сделал так, как, по моему разумению
[/vba] hands вот и нужно было в том же духе.
[vba]
Код
возникла масса вопросов
[/vba], так не нужно стесняться, задавайте их. У меня в школе учителя были, так они только одни вопросы и задавали. Я уж начинал подумывать, может они знать ничего не знают <_< . Но старался отвечать на все. За что и получал ... >( .
[vba]
Код
Поэтому, подумав, решил, что инициатива наказуема, и переписал ровно так, как было
[/vba], ну это Вы совсем зря :'( .
[vba]
Код
можете переписывать по своему разумению
[/vba], ещё бы знать, что там нужно переписывать %) .
[vba]
Код
К пуговицам претензии?
[/vba] нет, а вот кафтанчик-то без спинки сшит. Какой тут рекурсивный вариант, Я то CheckBox увидел только три дня назад! :'( и догнал что это флажок по таджикски.
[vba]
Код
Миша, где сказано, что нужно выполнять обратное действие?
[/vba], поэтому, подумав, решил, что инициатива наказуема, и оставил на Ваше решение.

bmv98rus, [vba]
Код
Я понял как....
[/vba], всё верно поняли. А если мне бы вбрендило что то в голову, так Я и переспросить смог бы. По роже все равно не дадут B) .
[vba]
Код
Что нужно - хз
[/vba], так и я о том же. "Вот пуля пролетела и ага". Дело то тут ваще в докторах. Энто они ..... выявили диабет на конечной стадии. Не хватило 5 ммоль что бы ласты склеить. Вот теперь решил взять всё под свой контроль с божьей помощью ( bmv98rus, RAN). yes
[vba]
Код
этот вариант позволяет более гибко делать перечисления
[/vba], от любой помощи не откажусь hands hands hands
Я же хочу получить график на котором бы отображались данные самоконтроля при помощью глюкометра. А флажками включать (отображать точки на графике) /отключать эти данные для анализа. Т.е.:
флажок 1 - кривая глюкозы;
флажок 2 - прямая (т.к. среднее за период) гемоглобина, но если нет данных глюкозы, то нет и гемоглобина;
флажок 3 - данные самоконтроля при помощи глюкометра (это точки на интерактивном графике) и вот здесь начинается: вкл флажок - отобразить все точки (флажки 4,5,6,7,8,9,10,11,12,13,14,15) за период дат, соответственно выкл. - отключить все точки.
но если нужно знать данные до приема (флажок 4) или после приёма пищи (флажок 5) то включают свои диапазоны (7,9,11) (8,10,12), соответственно и выкл.
флажок 6,13,14,15 не попадают в периоды до или после приёма пищи. это утром (6:00), перед сном (21:00), полночь (0:00), ночь (4:00) поэтому при включении:
флажка 6 - включается флажок 3, но он уже не включает все флажки, при выкл. отключается только флажок 6 пока включён хоть один флажок в группе 6,7,8,9,10,11,12,13,14,15.
то же самое 13,14,15
Ну вот как то так. На всякий случай прицеплю файл (рабочую версию)
Ещё раз Огромное Вам спасибо!!! :p
Жду Ваших предложений. И да, начальству, директору, декану и прочим мне этот файл не сдавать. Хочется довести его до ума прежде чем наступит Армагедон.
К сообщению приложен файл: _HbA1c_________.xlsb (89.1 Kb)


Сообщение отредактировал Gold_Barsik - Вторник, 01.10.2019, 23:38
 
Ответить
СообщениеОгромная благодарность и Вам bmv98rus, и Вам RAN, ну что с нас взять? Вот такие мы Обитатели.

RAN, [vba]
Код
сначала я сделал так, как, по моему разумению
[/vba] hands вот и нужно было в том же духе.
[vba]
Код
возникла масса вопросов
[/vba], так не нужно стесняться, задавайте их. У меня в школе учителя были, так они только одни вопросы и задавали. Я уж начинал подумывать, может они знать ничего не знают <_< . Но старался отвечать на все. За что и получал ... >( .
[vba]
Код
Поэтому, подумав, решил, что инициатива наказуема, и переписал ровно так, как было
[/vba], ну это Вы совсем зря :'( .
[vba]
Код
можете переписывать по своему разумению
[/vba], ещё бы знать, что там нужно переписывать %) .
[vba]
Код
К пуговицам претензии?
[/vba] нет, а вот кафтанчик-то без спинки сшит. Какой тут рекурсивный вариант, Я то CheckBox увидел только три дня назад! :'( и догнал что это флажок по таджикски.
[vba]
Код
Миша, где сказано, что нужно выполнять обратное действие?
[/vba], поэтому, подумав, решил, что инициатива наказуема, и оставил на Ваше решение.

bmv98rus, [vba]
Код
Я понял как....
[/vba], всё верно поняли. А если мне бы вбрендило что то в голову, так Я и переспросить смог бы. По роже все равно не дадут B) .
[vba]
Код
Что нужно - хз
[/vba], так и я о том же. "Вот пуля пролетела и ага". Дело то тут ваще в докторах. Энто они ..... выявили диабет на конечной стадии. Не хватило 5 ммоль что бы ласты склеить. Вот теперь решил взять всё под свой контроль с божьей помощью ( bmv98rus, RAN). yes
[vba]
Код
этот вариант позволяет более гибко делать перечисления
[/vba], от любой помощи не откажусь hands hands hands
Я же хочу получить график на котором бы отображались данные самоконтроля при помощью глюкометра. А флажками включать (отображать точки на графике) /отключать эти данные для анализа. Т.е.:
флажок 1 - кривая глюкозы;
флажок 2 - прямая (т.к. среднее за период) гемоглобина, но если нет данных глюкозы, то нет и гемоглобина;
флажок 3 - данные самоконтроля при помощи глюкометра (это точки на интерактивном графике) и вот здесь начинается: вкл флажок - отобразить все точки (флажки 4,5,6,7,8,9,10,11,12,13,14,15) за период дат, соответственно выкл. - отключить все точки.
но если нужно знать данные до приема (флажок 4) или после приёма пищи (флажок 5) то включают свои диапазоны (7,9,11) (8,10,12), соответственно и выкл.
флажок 6,13,14,15 не попадают в периоды до или после приёма пищи. это утром (6:00), перед сном (21:00), полночь (0:00), ночь (4:00) поэтому при включении:
флажка 6 - включается флажок 3, но он уже не включает все флажки, при выкл. отключается только флажок 6 пока включён хоть один флажок в группе 6,7,8,9,10,11,12,13,14,15.
то же самое 13,14,15
Ну вот как то так. На всякий случай прицеплю файл (рабочую версию)
Ещё раз Огромное Вам спасибо!!! :p
Жду Ваших предложений. И да, начальству, директору, декану и прочим мне этот файл не сдавать. Хочется довести его до ума прежде чем наступит Армагедон.

Автор - Gold_Barsik
Дата добавления - 01.10.2019 в 23:28
Gold_Barsik Дата: Среда, 02.10.2019, 02:47 | Сообщение № 30
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
Немного собрался с мыслями и вот что уменя получилось:
[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
[/vba]
 
Ответить
СообщениеНемного собрался с мыслями и вот что уменя получилось:
[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
[/vba]

Автор - Gold_Barsik
Дата добавления - 02.10.2019 в 02:47
Gold_Barsik Дата: Среда, 02.10.2019, 02:50 | Сообщение № 31
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
[vba]
Код

        Case "Check Box 6"
            ar = Array(3)
            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 7"
            ar = Array(3, 4)
            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 8"
            ar = Array(3, 5)
            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 9"
            ar = Array(3, 4)
            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 10"
            ar = Array(3, 5)
            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
[/vba]
 
Ответить
Сообщение[vba]
Код

        Case "Check Box 6"
            ar = Array(3)
            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 7"
            ar = Array(3, 4)
            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 8"
            ar = Array(3, 5)
            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 9"
            ar = Array(3, 4)
            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 10"
            ar = Array(3, 5)
            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
[/vba]

Автор - Gold_Barsik
Дата добавления - 02.10.2019 в 02:50
Gold_Barsik Дата: Среда, 02.10.2019, 02:51 | Сообщение № 32
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
[vba]
Код

        Case "Check Box 10"
            ar = Array(3, 5)
            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 11"
            ar = Array(3, 4)
            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 12"
            ar = Array(3, 5)
            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 13"
            ar = Array(3)
            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 14"
            ar = Array(3)
            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 15"
            ar = Array(3)
            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
        End Select
    End With
End Sub
[/vba]
Осталось совсем малость, найти ошибку у фл.2 и исправить огрехи.
А именно:
фл.2 - вкл. - выдаёт ошибку (галочку не ставить пока не будет включён фл.1), при выключении так же выбрасывает в ошибку
[vba]
Код
Run-time error '438': (Ошибка времени выполнения '438')
Object doesn't support this property or method (Объект не поддерживает это свойство или метод)
[/vba]
фл.3 - вкл. - нормально; выкл. - нормально, но при выключении одного из флажков 6,7,8,9,10,11,12,13,14,15 отключается нужный, а

именно:
при выкл. одного из фл.6,13,14,15 выключается фл.3, (не выкл. пока включён хотя бы один из фл. 4-15)
при выкл. одного из фл.7,9,11 выключаются фл.3 и 4, (не выкл. пока включён хотя бы один из фл. 7,9,11)
при выкл. одного из фл.8,10,12 выключаются фл.3 и 5, (не выкл. пока включён хотя бы один из фл. 8,10,12)
Ну вроде бы и всё :o .
 
Ответить
Сообщение[vba]
Код

        Case "Check Box 10"
            ar = Array(3, 5)
            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 11"
            ar = Array(3, 4)
            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 12"
            ar = Array(3, 5)
            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 13"
            ar = Array(3)
            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 14"
            ar = Array(3)
            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 15"
            ar = Array(3)
            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
        End Select
    End With
End Sub
[/vba]
Осталось совсем малость, найти ошибку у фл.2 и исправить огрехи.
А именно:
фл.2 - вкл. - выдаёт ошибку (галочку не ставить пока не будет включён фл.1), при выключении так же выбрасывает в ошибку
[vba]
Код
Run-time error '438': (Ошибка времени выполнения '438')
Object doesn't support this property or method (Объект не поддерживает это свойство или метод)
[/vba]
фл.3 - вкл. - нормально; выкл. - нормально, но при выключении одного из флажков 6,7,8,9,10,11,12,13,14,15 отключается нужный, а

именно:
при выкл. одного из фл.6,13,14,15 выключается фл.3, (не выкл. пока включён хотя бы один из фл. 4-15)
при выкл. одного из фл.7,9,11 выключаются фл.3 и 4, (не выкл. пока включён хотя бы один из фл. 7,9,11)
при выкл. одного из фл.8,10,12 выключаются фл.3 и 5, (не выкл. пока включён хотя бы один из фл. 8,10,12)
Ну вроде бы и всё :o .

Автор - Gold_Barsik
Дата добавления - 02.10.2019 в 02:51
Gold_Barsik Дата: Пятница, 25.10.2019, 04:36 | Сообщение № 33
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
Что то всё встало на мёртвой точке. То ли лыжи по асфальту ни едут, то ли гора к Магомеду не идёт.


Сообщение отредактировал Gold_Barsik - Пятница, 25.10.2019, 04:37
 
Ответить
СообщениеЧто то всё встало на мёртвой точке. То ли лыжи по асфальту ни едут, то ли гора к Магомеду не идёт.

Автор - Gold_Barsik
Дата добавления - 25.10.2019 в 04:36
Gold_Barsik Дата: Суббота, 26.10.2019, 16:20 | Сообщение № 34
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
Уважаемый RAN, не соизволите разъяснить как работает Ваш макрос. Галочки в флажках я и так смог бы ставить. А вот с макросом не совсем понимаю. Вроде ставлю, а результата нет. В чём же секрет Вашего макроса?
Вы пишите [vba]
Код
Дописал в соответствии с описанием требуемых действий, заодно и лишнее убрал.
[/vba] но на выходе (((


Сообщение отредактировал Gold_Barsik - Суббота, 26.10.2019, 16:22
 
Ответить
СообщениеУважаемый RAN, не соизволите разъяснить как работает Ваш макрос. Галочки в флажках я и так смог бы ставить. А вот с макросом не совсем понимаю. Вроде ставлю, а результата нет. В чём же секрет Вашего макроса?
Вы пишите [vba]
Код
Дописал в соответствии с описанием требуемых действий, заодно и лишнее убрал.
[/vba] но на выходе (((

Автор - Gold_Barsik
Дата добавления - 26.10.2019 в 16:20
Gold_Barsik Дата: Понедельник, 28.10.2019, 03:42 | Сообщение № 35
Группа: Проверенные
Ранг: Обитатель
Сообщений: 459
Репутация: 6 ±
Замечаний: 0% ±

2003
Уважаемые форумчане! Здравствуйте!
И всё таки, может кто нибудь помочь с этим злополучным макросом???
Я его и так и эдак, но не хочет работать. Может что-то не так делаю? Может он вовсе не для 2003?
То флаги не переименовываются, то чек-боксы.
Набрал новый Лист. Чистый. Только флаги и условия их работы (справа в трёх столбцах).
Окажите посильную помощь несведущему в макросах. Пожалуйста! Заранее Спасибо!
К сообщению приложен файл: 2701745.xls (22.0 Kb)


Сообщение отредактировал Gold_Barsik - Понедельник, 28.10.2019, 03:46
 
Ответить
СообщениеУважаемые форумчане! Здравствуйте!
И всё таки, может кто нибудь помочь с этим злополучным макросом???
Я его и так и эдак, но не хочет работать. Может что-то не так делаю? Может он вовсе не для 2003?
То флаги не переименовываются, то чек-боксы.
Набрал новый Лист. Чистый. Только флаги и условия их работы (справа в трёх столбцах).
Окажите посильную помощь несведущему в макросах. Пожалуйста! Заранее Спасибо!

Автор - Gold_Barsik
Дата добавления - 28.10.2019 в 03:42
Мир MS Excel » Вопросы и решения » Вопросы по VBA » управление флажками (Excel 2003) (Макросы/Sub)
  • Страница 2 из 2
  • «
  • 1
  • 2
Поиск:

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