Домашняя страница 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
Цитата Gold_Barsik, 01.10.2019 в 09:06, в сообщении № 18 ()
Знать бы что туда ещё необходимо прописать

А кто это знать должен? Я не экстрасенс.
Дописал в соответствии с описанием требуемых действий, заодно и лишнее убрал.
[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]

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Цитата Gold_Barsik, 01.10.2019 в 09:06, в сообщении № 18 ()
Знать бы что туда ещё необходимо прописать

А кто это знать должен? Я не экстрасенс.
Дописал в соответствии с описанием требуемых действий, заодно и лишнее убрал.
[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

Цитата Gold_Barsik, 01.10.2019 в 17:56, в сообщении № 23 ()
В предыдущем хоть три флага работало

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

Цитата Gold_Barsik, 01.10.2019 в 17:56, в сообщении № 23 ()
а сейчас ваще пипец.

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

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

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

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

Цитата Gold_Barsik, 01.10.2019 в 17:56, в сообщении № 23 ()
В предыдущем хоть три флага работало

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

Цитата Gold_Barsik, 01.10.2019 в 17:56, в сообщении № 23 ()
а сейчас ваще пипец.

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

[p.s.]К пуговицам претензии есть?[/p.s.]
Автор - RAN
Дата добавления - 01.10.2019 в 18:34
bmv98rus Дата: Вторник, 01.10.2019, 20:10 | Сообщение № 25
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4115
Репутация: 769 ±
Замечаний: 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
Миша, ты плохо читаешь. И принимаешь написанное за то, что, вероятно, должно было быть написано.
Цитата RAN, 01.10.2019 в 18:34, в сообщении № 24 ()
при включении флажка 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
 
Ответить
СообщениеМиша, ты плохо читаешь. И принимаешь написанное за то, что, вероятно, должно было быть написано.
Цитата RAN, 01.10.2019 в 18:34, в сообщении № 24 ()
при включении флажка 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
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4115
Репутация: 769 ±
Замечаний: 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 обязательна!