powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Прибавление выделения листов к уже выделенным посредством второго макроса
13 сообщений из 13, страница 1 из 1
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33338426
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Подскажите пожалуйста как сделать, что бы после нажатия CommandButton1 и выделении листов "Master", можно было нажать CommandButton2 и прибавить к уже выделенным листам листы "Office".
В данном случае при по переменном нажатии кнопок выделенние предыдущих листов пропадает. Заранее благодарен.


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Private Sub CommandButton1_Click()
    If CommandButton1.Value = True Then
    Sheets(Array("Master", "Master 2", "Master 3", "Master 4", "Master 5")).Select
    End If
End Sub
Private Sub CommandButton2_Click()
    If CommandButton2.Value = True Then
    Sheets(Array("Office", Office  2 ", Office 3", Office  4 ", Office 5")).Select
    End If
End Sub
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33339245
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вроде справился сам. Но другя задача возникла:
Из общего числа уже выделенных листов, нужно снять выделение листов Office или Master, но при этом нужно что бы остались выделенными остальные выделенные листы.
Не могу найти как програмно снимать выделение с листов.
Помогите пожалуйста доделать макрос, в данном случае при нажатии CheckBox1 или CheckBox2, в момент когда они активны, он снимает выделение со всех выделенных листов, а не только с привязанных к каждому из них листов.


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
Private Sub CheckBox1_Click()
    If CheckBox1.Value = True Then
    Sheets(Array("INFO", "Master", "Master 2", "Master 3", "Master 4", "Master 5")).Select False
    ElseIf CheckBox1.Value = False Then
    Sheets(Array("INFO")).Select True
    End If
End Sub
Private Sub CheckBox2_Click()
    If CheckBox2.Value = True Then
    Sheets(Array("INFO", "Office", Office  2 ", Office 3", Office  4 ", Office 5")).Select False
    ElseIf CheckBox2.Value = False Then
    Sheets(Array("INFO")).Select True
    End If
End Sub
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33339587
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Private Sub CheckBox1_Click()
MySelect
End Sub

Private Sub CheckBox2_Click()
MySelect
End Sub

Private Sub MySelect()
    Select Case CheckBox2.Value
    Case True
        Select Case CheckBox1.Value
        Case True
            Sheets(Array("INFO", "Master", "Master 2", "Master 3", "Master 4", "Master 5", _
            "Office", "Office 2", "Office 3", "Office 4", "Office 5")).Select  ' 1. оба выделены
        Case False
            Sheets(Array("INFO", "Master 2", "Master 3", "Master 4", "Master 5", _
            "Office", "Office 2", "Office 3", "Office 4", "Office 5")).Select  ' 2. второй выделен первый нет
        End Select
    Case False
        Select Case CheckBox1.Value
        Case True
            Sheets(Array("INFO", "Master", "Master 2", "Master 3", "Master 4", "Master 5", _
            "Office 2", "Office 3", "Office 4", "Office 5")).Select  ' 3. первый выделен второй нет
        Case False
            Sheets(Array("INFO", "Master 2", "Master 3", "Master 4", "Master 5", _
            "Office 2", "Office 3", "Office 4", "Office 5")).Select  ' 4. оба сняты
        End Select
    End Select
End Sub
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33340222
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Большое спасибо, пришлось не много переделать, но блин обидно, на самом деле у меня 20 боксов, думал сам переделаю, но не получается. Может можно как то упростить?

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
Private Sub CheckBox1_Click()
MySelect
End Sub

Private Sub CheckBox2_Click()
MySelect
End Sub

Private Sub MySelect()
    Select Case CheckBox2.Value
    Case True
        Select Case CheckBox1.Value
        Case True
            Sheets(Array("INFO", "Master", "Master 2", "Master 3", "Master 4", "Master 5", _
            "Ch.Off.", "Ch.Off. 2", "Ch.Off. 3", "Ch.Off. 4", "Ch.Off. 5")).Select  ' 1. оба выделены
        Case False
            Sheets(Array("INFO", "Ch.Off.", "Ch.Off. 2", "Ch.Off. 3", "Ch.Off. 4", "Ch.Off. 5")).Select  ' 2. второй выделен первый нет
        End Select
    Case False
        Select Case CheckBox1.Value
        Case True
            Sheets(Array("INFO", "Master", "Master 2", "Master 3", "Master 4", "Master 5")).Select  ' 3. первый выделен второй нет
        Case False
            Sheets(Array("INFO")).Select  ' 4. оба сняты
        End Select
    End Select
End Sub
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33341832
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
если у тебя 20 боксов и каждый выделяет лист
можно сделать так
в CheckBox-ах переменая True - False и
вызываешь процедуру передаёшь туда переменную и имя листа
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
Private Sub CheckBox1_Click()
Dim MyTr As Boolean
    Select Case CheckBox1.Value
        Case True
            MyTr = True
        Case False
            MyTr = False
    End Select
    MySelect1 MyTr, [color=red]"Ch.Off."[/color]
End Sub

Private Sub CheckBox2_Click()
Dim MyTr As Boolean
    Select Case CheckBox2.Value
        Case True
            MyTr = True
        Case False
            MyTr = False
    End Select
    MySelect1 MyTr, [color=red]"Master"[/color]
End Sub

'1. определяем выделенные листы
'2.1 если True то добавляем в массив имя листа
'2.2 если False то перебераем массив и выкидываем имя листа
'3. выделяем листы

Private Sub MySelect1(MyTr As Boolean, MyLi As String)
Dim a As Byte
Dim MyArr() As String
    'определение количества выделенных листов
    a = Windows(ThisWorkbook.Name).SelectedSheets.Count

    If MyTr = True Then
        ReDim MyArr(a) 'переобьявление массива
        a =  0 
        'определение выделенных листов
        For Each sh In Windows(ThisWorkbook.Name).SelectedSheets
            MyArr(a) = sh.Name
            a = a +  1 
        Next
        ' добавляем в массив имя листа
        MyArr(a) = MyLi
    Else
        ReDim MyArr(a -  2 ) ' переобьявление массива
        a =  0 
        'определение выделенных листов
        For Each sh In Windows(ThisWorkbook.Name).SelectedSheets
            If sh.Name <> MyLi Then
                MyArr(a) = sh.Name
                a = a +  1 
            End If
        Next
    End If
    'выделяем листы
    Worksheets(MyArr()).Select

End Sub
можно оформить как функцию
Private Function()
...
End Function
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33343153
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Большое спасибо.
Последний вопрос, подскажите пожалуйста как программно снять флажки с 20 боксов сразу, (Value = False) нажатием на CommandButton.
Заранее благодарен.
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33343345
Посмотри здесь.
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33343777
Suleyman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
По моему это не совсем то что мне нужно:
Код: plaintext
1.
2.
3.
4.
5.
6.
    Dim obj As OLEObject
    For Each obj In Worksheets("Лист1").OLEObjects
        MsgBox obj.Name
        If obj.ProgId = "Forms.CheckBox.1" Then
            obj.Object.Value =  1 
        End If
    Next

Мне кажется должо выглядеть примерно так:
Код: plaintext
1.
2.
3.
4.
5.
6.
Sub CHeckBoxClear()
    Worksheets("INFO").Shapes.Range(Array("CheckBox1", "CheckBox2", "CheckBox3", _
        "CheckBox4", "CheckBox5", "CheckBox6", "CheckBox7", "CheckBox8" _
    , "CheckBox9", "CheckBox10", "CheckBox11", "CheckBox12" _
    , "CheckBox13", "CheckBox14", "CheckBox15", "CheckBox16" _
    , "CheckBox17", "CheckBox18", "CheckBox19", "CheckBox20")).Value = False
End Sub
но поскольку я не силен в этом, то сам не врублюся как через массив это делать.
Помогите please!
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33343984
Если это элемент управления, то:

Код: plaintext
1.
2.
3.
4.
5.
6.
    Dim obj As OLEObject
    
    For Each obj In Worksheets("Лист1").OLEObjects
        If obj.ProgId = "Forms.CheckBox.1" Then
            obj.Object.Value =  0 
        End If
    Next

Если Checkbox добавлен с помощью панели "Формы", то:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
    Dim s As Shape  
    
    For Each s In Worksheets( 1 ).Shapes
        If s.Type = msoFormControl Then
            If s.FormControlType = xlCheckBox Then
                s.ControlFormat.Value =  0 
            End If
        End If
    Next
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33344153
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А если это UserForms тогда так

Код: plaintext
1.
2.
3.
4.
5.
6.
Private Sub Commandbutton1_Click()
Dim ctl As Control
For Each ctl In UserForm1.Controls
    If TypeName(ctl) = "CheckBox" Then _
    ctl.Value = False
Next ctl
End Sub
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33346011
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Огромное спасибо, все работает отлично. Последняя просьба, нужен макрос который будет запускать на печать все выделенные листы кроме первого "INFO" И еще если не трудно подскажите как создать массив из пяти листов и привязать его к CheckBox-у, перерыл "справку" но не могу найти, понимаю что вопрос детский, но если не трудно. Просто через 2 дня ухожу в море на пол года, там не у кого будет спросить.
Заранее огромное спасибо!
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33346944
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
передавай привет морю

макрос для печати
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
Private Sub MyPrint()
Dim a As Byte
Dim MyArr() As String
Dim MyPr() As String
    'определение количества выделенных листов
    a = Windows(ThisWorkbook.Name).SelectedSheets.Count
        ReDim MyArr(a -  2 ) ' переобьявление массива
        a =  0 
        'определение выделенных листов
        For Each sh In Windows(ThisWorkbook.Name).SelectedSheets
            If sh.Name <> "INFO" Then
                MyArr(a) = sh.Name
                a = a +  1 
            End If
        Next
    'выделяем листы
    Worksheets(MyArr()).Select
    'печатаем
    ActiveWindow.SelectedSheets.PrintOut Copies:= 1 , Collate:=True
    ReDim MyPr(a) ' переобьявление массива
    For x =  0  To UBound(MyArr)
        MyPr(x) = MyArr(x)
    Next x
    MyPr(a) = "INFO"
    Worksheets(MyPr()).Select
End Sub
DimenИ еще если не трудно подскажите как создать массив из пяти листов и привязать его к CheckBox-у,

Не понял вопрос уточни
если тебе нужно выделить n-е количество листов одним CheckBox-ом то:
см. CheckBox3 в нём переменная MyLi можешь в неё писать сколько хочешь листов через запятую

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
Private Sub CheckBox1_Click()
Dim MyTr As Boolean
    Select Case CheckBox1.Value
        Case True
            MyTr = True
        Case False
            MyTr = False
    End Select
    MySelect1 MyTr, "Ch.Off."
End Sub
Private Sub CheckBox2_Click()
Dim MyTr As Boolean
    Select Case CheckBox2.Value
        Case True
            MyTr = True
        Case False
            MyTr = False
    End Select
    MySelect1 MyTr, "Master"
End Sub
Private Sub CheckBox3_Click()
Dim MyTr As Boolean
Dim MyLi As String
    Select Case CheckBox3.Value
        Case True
            MyTr = True
        Case False
            MyTr = False
    End Select
    MyLi = "Master 2,Master 3,Master 4"
    MySelect1 MyTr, MyLi
End Sub


Private Sub MySelect1(MyTr As Boolean, MyLi As String)
Dim a As Byte, b As Byte, c As Byte
Dim MyArr() As String
Dim PrStr As String
    If MyLi Like "*,*" Then
        Proba = Split(MyLi, ",")
        b = UBound(Proba)
    Else:
        b =  0 
    End If

    'определение количества выделенных листов
    a = Windows(ThisWorkbook.Name).SelectedSheets.Count

    If MyTr = True Then
        ReDim MyArr(a + b) ' переобьявление массива
        c = UBound(MyArr)
        a =  0 
        'определение выделенных листов
        For Each Sh In Windows(ThisWorkbook.Name).SelectedSheets
            MyArr(a) = Sh.Name
            a = a +  1 
        Next
        ' добавляем в массив имя листа(ов)
        If b <>  0  Then
            For x = a To c
                MyArr(x) = Proba(x - a)
            Next x
        Else
            MyArr(a) = MyLi
        End If
        'выделяем листы
        Worksheets(MyArr()).Select
    ElseIf a <>  1  Then
        ReDim MyArr(a - b -  2 ) ' переобьявление массива
        a =  0 
        'определение выделенных листов
        For Each Sh In Windows(ThisWorkbook.Name).SelectedSheets
        PrStr = "*" & Sh.Name & "*"
            If Not MyLi Like PrStr Then
                MyArr(a) = Sh.Name
                a = a +  1 
            End If
        Next
    'выделяем листы
    Worksheets(MyArr()).Select
    End If

End Sub

а это цитата из книги Джона Уокенбаха

Массивы
Массив — это группа элементов одного типа, которые имеют общее имя, на конкретный элемент массива ссылаются, используя имя массива и индекс. Например, можно определить массив из 12-ти строк так, чтобы каждая переменная соответствовала названию месяца. Если вы назовете массив MonthNames, то можете обратиться к первому элементу массива как MonthNames(0), ко второму — как MonthNames (1) и т.д., до MonthNames(11)
Объявление массивов

Массив, как и обычные переменные, объявляется с помощью операторов Dim или Public Кроме того, можно определить количество элементов в массиве: введите первый индексный номер, ключевое слово То и последний индексный номер — вся конструкция будет заключена в скобки. Например, так можно объявить массив, содержащий ровно 100 целых чисел
Dim MyArray(1 To 100) As integer

При объявлении массива обязательно следует указывать только верхний индекс тогда VBA предопределяет нижний индекс равный нулю. Следовать дующих оператора приведут к одинаковым результатам:
Dim MyArray(0 То 100) As Integer
Dim MyArray(lOO) As Integer
Объявление многомерных массивов
В обоих случаях массив состоит из 101-го элемента.
В примерах массивов в предыдущем разделе использовались одномерные массивы Массивы VBA могут иметь до 60-ти измерений, хотя на самом деле используется не более трех (трехмерные массивы). Показанный ниже оператор объявляет двухмерный 100-элсментный массив целых чисел:
Dim MyArrayd To 10, 1 То 10) As Integer
Этот массив можно рассматривать как матрицу значений 10x10. Чтобы обратится к конкретному элементу двухмерного массива; используйте два индексных номера. Например таким образом присваивается значение элементу предыдущего массива.
МуАггау(3, 4) = 125
Трехмерный массив можно рассматривать как куб, но не существует способа визуально представить данные массива, в котором больше трех измерений.
Динамический массив не имеет предопределенного количества элементов. Дннамический массив объявляется с незаполненными значениями в скобках;
Dim MyArray() As Integer

Тем не менее, прежде чем динамический массив можно будет использовать в программе, необходимо обратиться к оператору ReDim, указывающему VBA, сколько элементов находится в массиве (или ReDim Preserve, если вы решили сохранить текущую длину массива). Оператор ReDim можно использовать сколько угодно раз, изменяя, если требуется, размер массива, будут рассмотрены далее в этой главе при обсуждении циклов.
...
Рейтинг: 0 / 0
Прибавление выделения листов к уже выделенным посредством второго макроса
    #33348685
Dimen
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Отлично работает, спасибо Vkodor! Хоть сам я и не программист, но приятно что кто то может помочь в стремлении к свету.
Спасибо всем!
...
Рейтинг: 0 / 0
13 сообщений из 13, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Прибавление выделения листов к уже выделенным посредством второго макроса
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]