Private Sub UserForm_Activate()
'для листа "ДД"
'Application.ScreenUpdating = False
On Error Resume Next
Const ВысотаForm As Integer = 404 'UserForm3
With UserForm3
.Width = 392 'ширина 400
.Height = ВысотаForm '404 'высота
.Top = 195 '0 'сверху вниз
.Left = 700 '0 'слева направо
'.Caption = "Компоненты" 'название формы
.BackColor = RGB(230, 255, 255) 'цвет фона
'изменение шрифта програмно не доступно
'и в свойствах не изменишь!?
'тогда и название вручную
''''''
Const ВысотаListBox As Integer = 375
'ListBox по 2 столбцам
With .ListBox1
.Width = 200 'ширина, если два столбца и больше, то ширина ListBox > суммы ширины столбцов
.Height = ВысотаListBox 'высота'375
.Left = 6 'отступ от левой границы формы
.Top = 23 '30
.Visible = True 'отключаем видимость, т.е. при активации листа его невидно
.Enabled = True 'доступ к выбору значений, по умолчанию True, можно False - нет доступа
.ListStyle = fmListStyleOption 'выделенный элемент выделяется галочкой
.MultiSelect = fmMultiSelectMulti '1 - простой выбор нескольких значений
.MousePointer = fmMousePointerDefault 'нормальная Стрелка - по умолчанию
.ColumnHeads = False
.ColumnCount = 2 'количество столбцов, меняем по количеству столбцов
.ColumnWidths = "140;40" 'ширина двух столбцов, меняем по количеству столбцов, через запятую
.BackColor = QBColor(15) 'цвет фона 15 - фон белый, 7; 11
.BorderStyle = fmBorderStyleNone 'стиль рамки - fmBorderStyleNone - объемная (по умолчанию),fmBorderStyleSingle - без объема
.ForeColor = QBColor(0) 'цвет текста, 0 - по умолчанию; 3 - нормально
.TextAlign = fmTextAlignLeft 'форматирование текста - расположение слева
End With
End With
'загружаем компонеты в ListBox1
Dim i As Integer, Row As Integer
i = 0
For Row = 7 To 32
UserForm3.ListBox1.AddItem 'обязательная строка, добавляем элемент List
UserForm3.ListBox1.List(i, 0) = Sheets("Сжатый формат").Cells(Row, 1)
UserForm3.ListBox1.List(i, 1) = Sheets("Сжатый формат").Cells(Row, 5)
i = i + 1
Next Row
'List(i,0). i - номер строки;0 - первый столбец в ListBox1
'List(i,1). i - номер строки;1 - второй столбец в ListBox1 и т.д.
'List(i,2). i - номер строки;2 - третий столбец в ListBox1 и т.д.
'List(i,3). i - номер строки;3 - четвертый столбец в ListBox1 и т.д.
'формат текста
With UserForm3.ListBox1.Font
.Bold = msoTrue 'полужирный (msoFalse - обычный)
.Name = "+mn-lt" 'шрифт - +основной
.Size = 11
'цвет програмно изменить в ListBox нельзя, только в свойствах
End With
''''''
'выставляем свойства
With UserForm3.ListBox2
.Width = 155 'ширина, если два столбца и больше, то ширина ListBox > суммы ширины столбцов
.Height = ВысотаListBox 'высота 375
.Left = 226 'отступ от левой границы формы
.Top = 23 '30
.Visible = True 'отключаем видимость, т.е. при активации листа его невидно
.Enabled = True 'доступ к выбору значений, по умолчанию True, можно False - нет доступа
.ListStyle = fmListStyleOption 'выделенный элемент выделяется галочкой
.MultiSelect = fmMultiSelectMulti '1 - простой выбор нескольких значений
.MousePointer = fmMousePointerDefault 'нормальная Стрелка - по умолчанию
.ColumnHeads = False 'заголовки столбцов не выводятся
.BackColor = QBColor(15) 'цвет фона 15 - фон белый, 7; 11
.BorderStyle = fmBorderStyleNone 'стиль рамки - fmBorderStyleNone - объемная (по умолчанию),fmBorderStyleSingle - без объема
.ForeColor = QBColor(3) 'цвет текста, 0 - по умолчанию; 3 - нормально
.TextAlign = fmTextAlignLeft 'форматирование текста - расположение слева
End With
''''''
'загружаем компонеты в ListBox2
i = 0
For Row = 7 To 32
UserForm3.ListBox2.AddItem 'обязательная строка
UserForm3.ListBox2.List(i, 0) = Sheets("Сжатый формат").Cells(Row, 1)
'UserForm3.ListBox2.List(i, 1) = Sheets("Сжатый формат").Cells(Row, 5) 'для ListBox2 - лишняя строка, максимальные добавлены в ListBox1
i = i + 1
Next Row
'формат текста
With UserForm3.ListBox2.Font
.Bold = msoTrue 'полужирный (msoFalse - обычный)
.Name = "+mn-lt" 'шрифт - +основной
.Size = 11
'цвет програмно изменить в ListBox нельзя, только в свойствах
End With
''''''
With UserForm3.Label1
.Width = 140 'ширина
.Height = 16 'высота
.Top = 6 'сверху вниз 12
.Left = 6 'слева направо
.Caption = "Левая ось Y" 'название формы
.TextAlign = fmTextAlignCenter 'расположение текста
.BackColor = QBColor(7) 'цвет фона 15 - фон белый, 7; 11
.ForeColor = QBColor(0) 'цвет текста
With .Font
.Bold = True 'полужирный (False - обычный)
.Name = "Arial" 'не работает програмно !? вручную
.Size = 14
'World Wrap 'размещение в ддва ряда при необходимости выставлять вручную
End With
End With
'остальные свойства по умочанию, как настроено Label в UserForm
With UserForm3.Label2
.Width = 48 'ширина
.Height = 16 'высота
.Top = 6 'сверху вниз 12
.Left = 158 'слева направо
.Caption = "Макс." 'название формы
.TextAlign = fmTextAlignCenter 'расположение текста
.BackColor = QBColor(7) 'цвет фона 15 - фон белый, 7; 11
.ForeColor = QBColor(0) 'цвет текста
With .Font
.Bold = True 'полужирный (False - обычный)
.Name = "Arial" 'не работает програмно !? вручную
.Size = 14
End With
End With
With UserForm3.Label3
.Width = 155 'ширина
.Height = 16 'высота
.Top = 6 'сверху вниз 12
.Left = 226 'слева направо
.Caption = "Правая ось Y" 'название формы
.TextAlign = fmTextAlignCenter 'расположение текста
.BackColor = QBColor(7) 'цвет фона 15 - фон белый, 7; 11
.ForeColor = QBColor(3) 'цвет текста
With .Font
.Bold = True 'полужирный (False - обычный)
.Name = "Arial" 'не работает програмно !? вручную
.Size = 14
End With
End With
'''''''
'сохраняем значение при открытии ListBox
'работает, но лучше циклом
'For a = 2 To 4
'If Sheets("ДД").Cells(30, a).Text = "Углерод оксид" Then _
'UserForm3.ListBox1.Selected(0) = True
'Next
'For a = 2 To 4
'If Sheets("ДД").Cells(30, a).Text = "Азота оксид" Then _
'UserForm3.ListBox1.Selected(1) = True
'Next
'For a = 2 To 4
'If Sheets("ДД").Cells(30, a).Text = "Азота диоксид" Then _
'UserForm3.ListBox1.Selected(2) = True
'Next
'''''''
'сохраняем значение при открытии UserForm
Dim Kom(26) As Range
'присваиваем Set c 1 по 26 значения ячеек с А7 по А32
bb = 7
For aa = 1 To 26
Set Kom(aa) = Workbooks("Парк.xlsb").Sheets("Сжатый формат").Range("A" & bb)
bb = bb + 1
Next
'сохраняем значение при открытии ListBox1 на форме
For a = 2 To 4
For aa = 1 To 26
If Sheets("ДД").Cells(37, a).Text = Kom(aa) Then _
UserForm3.ListBox1.Selected(aa - 1) = True
Next
Next
'сохраняем значение при открытии ListBox2 на форме
For a = 5 To 7
For aa = 1 To 26
If Sheets("ДД").Cells(37, a).Text = Kom(aa) Then _
UserForm3.ListBox2.Selected(aa - 1) = True
Next
Next
'Application.ScreenUpdating = True
End Sub
|
