Здравствуйте уважаемые форумчане. Необходима помощь в решении следующей задачи, в приложенном файле список, при нажатии на кнопку отправить открывается форма UserForm созданная с помощью редактора, необходимо: 1. Что бы форма UserForm создавалась в процессе выполнения макроса, т.е. изначально шаблон не был создан в редакторе. 2. Имела динамические границы, т.е. заполнялась в зависимости от того, если в столбце F в примере стоит "пв". Есть ли возможность решения таких задач? Заранее спасибо. [moder]А где в файле макросы и форма?
Здравствуйте уважаемые форумчане. Необходима помощь в решении следующей задачи, в приложенном файле список, при нажатии на кнопку отправить открывается форма UserForm созданная с помощью редактора, необходимо: 1. Что бы форма UserForm создавалась в процессе выполнения макроса, т.е. изначально шаблон не был создан в редакторе. 2. Имела динамические границы, т.е. заполнялась в зависимости от того, если в столбце F в примере стоит "пв". Есть ли возможность решения таких задач? Заранее спасибо. [moder]А где в файле макросы и форма?Sashagor1982
Если не трудно можно кратко объяснить как работает код? [vba]
Код
Private Sub UserForm_Initialize() Dim x, i&, s x = Range("A5:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value With ActiveSheet If .FilterMode Then .ShowAllData End With For i = 1 To UBound(x) If x(i, 6) = "пв" Then s = s & "~" & x(i, 1) Next i If Len(s) Then Me.ListBox1.List = Split(Mid(s, 2), "~") End Sub
[/vba]
Если не трудно можно кратко объяснить как работает код? [vba]
Код
Private Sub UserForm_Initialize() Dim x, i&, s x = Range("A5:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value With ActiveSheet If .FilterMode Then .ShowAllData End With For i = 1 To UBound(x) If x(i, 6) = "пв" Then s = s & "~" & x(i, 1) Next i If Len(s) Then Me.ListBox1.List = Split(Mid(s, 2), "~") End Sub
Так будет без возможных повторов, и правильнее - первым делом нужно снять фильтры! [vba]
Код
Private Sub UserForm_Initialize() Dim x, i&
With ActiveSheet If .FilterMode Then .ShowAllData End With
x = Range("A5:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject("scripting.dictionary"): .comparemode = 1 For i = 1 To UBound(x) If x(i, 6) = "пв" Then .Item(x(i, 1)) = 0& Next i If .Count Then Me.ListBox1.List = .keys End With
End Sub
[/vba]
Так будет без возможных повторов, и правильнее - первым делом нужно снять фильтры! [vba]
Код
Private Sub UserForm_Initialize() Dim x, i&
With ActiveSheet If .FilterMode Then .ShowAllData End With
x = Range("A5:F" & Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject("scripting.dictionary"): .comparemode = 1 For i = 1 To UBound(x) If x(i, 6) = "пв" Then .Item(x(i, 1)) = 0& Next i If .Count Then Me.ListBox1.List = .keys End With
Можно словарь сделать публичным и запоминать вместо нуля номер строки. Затем обрабатываем галочки - извлекаем из словаря номер строки, по номеру в ячейку пишем что угодно.
Можно словарь сделать публичным и запоминать вместо нуля номер строки. Затем обрабатываем галочки - извлекаем из словаря номер строки, по номеру в ячейку пишем что угодно.Hugo
Что бы форма создавалась в процессе выполнения макроса, т.е. изначально шаблон не был создан в редакторе
В порядке эксперимента решил тоже поучаствовать. К цитируемому подошёл в буквальном смысле - до начала работы макроса формы в файле не существует. Решение - на базе старого доброго Dialog Sheet, который хоть уже и не появляется в предлагаемом списке типов при объявлении переменных, но тихо продолжает обитать внутри Excel. Фишка (хотя и сомнительная) в том, что форма диалога генерируется на лету, для этого создается скрытый лист диалога, который после использования списка уничтожается. В качестве дополнительного бонуса подаю список на выбор в отсортированном виде. Обратите также внимание, что всё действие ограничено одной единственной процедурой.
[vba]
Код
Sub formOnDialogSheet()
Dim ds As DialogSheet Dim df As DialogFrame Dim lb As ListBox Dim x, i&, s, sel, str Dim bSaved As Boolean Dim rst As Object
'подготовка к созданию отсортированного списка Set rst = CreateObject("ADODB.Recordset") rst.Fields.Append "F1", 200, 100 rst.Open
With Worksheets("ШТАТ") If .FilterMode Then .ShowAllData x = .Range("A5:F" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value End With
For i = 1 To UBound(x) If x(i, 6) = "пв" Then rst.AddNew "F1", x(i, 1) Next i rst.Sort = "F1 ASC"
'фиксируем состояние "сохранности" книги перед созданием диалога bSaved = ThisWorkbook.saved
'создаем невидимый лист диалога (привет из Excel 5) Set ds = DialogSheets.Add(before:=ActiveSheet) ds.Visible = xlSheetHidden
Set df = ds.DialogFrame df.Caption = "Множественный выбор из списка" df.Height = 2 * df.Height
'наполняем список With rst .MoveFirst While Not .EOF lb.List(.AbsolutePosition) = !F1 .MoveNext Wend End With
'отображаем диалог (выполнение останавливается до закрытия) ds.Show
'после закрытия диалога 'обрабатываем выбор пользователя (например, отображаем) sel = lb.Selected For i = LBound(sel) To UBound(sel) If sel(i) Then str = str & ", " & lb.List(i) Next i
MsgBox Mid(str, 3), vbOKOnly, "Выбранные элементы списка"
Что бы форма создавалась в процессе выполнения макроса, т.е. изначально шаблон не был создан в редакторе
В порядке эксперимента решил тоже поучаствовать. К цитируемому подошёл в буквальном смысле - до начала работы макроса формы в файле не существует. Решение - на базе старого доброго Dialog Sheet, который хоть уже и не появляется в предлагаемом списке типов при объявлении переменных, но тихо продолжает обитать внутри Excel. Фишка (хотя и сомнительная) в том, что форма диалога генерируется на лету, для этого создается скрытый лист диалога, который после использования списка уничтожается. В качестве дополнительного бонуса подаю список на выбор в отсортированном виде. Обратите также внимание, что всё действие ограничено одной единственной процедурой.
[vba]
Код
Sub formOnDialogSheet()
Dim ds As DialogSheet Dim df As DialogFrame Dim lb As ListBox Dim x, i&, s, sel, str Dim bSaved As Boolean Dim rst As Object
'подготовка к созданию отсортированного списка Set rst = CreateObject("ADODB.Recordset") rst.Fields.Append "F1", 200, 100 rst.Open
With Worksheets("ШТАТ") If .FilterMode Then .ShowAllData x = .Range("A5:F" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value End With
For i = 1 To UBound(x) If x(i, 6) = "пв" Then rst.AddNew "F1", x(i, 1) Next i rst.Sort = "F1 ASC"
'фиксируем состояние "сохранности" книги перед созданием диалога bSaved = ThisWorkbook.saved
'создаем невидимый лист диалога (привет из Excel 5) Set ds = DialogSheets.Add(before:=ActiveSheet) ds.Visible = xlSheetHidden
Set df = ds.DialogFrame df.Caption = "Множественный выбор из списка" df.Height = 2 * df.Height
'наполняем список With rst .MoveFirst While Not .EOF lb.List(.AbsolutePosition) = !F1 .MoveNext Wend End With
'отображаем диалог (выполнение останавливается до закрытия) ds.Show
'после закрытия диалога 'обрабатываем выбор пользователя (например, отображаем) sel = lb.Selected For i = LBound(sel) To UBound(sel) If sel(i) Then str = str & ", " & lb.List(i) Next i
MsgBox Mid(str, 3), vbOKOnly, "Выбранные элементы списка"
Gustav, классно, но тоже сперва нужно снять фильтры...
Hugo, Игорь, так я там, вроде, снимаю, в смысле снимаете вы с nilem, а я у вас передираю А так любопытно, согласись, при не сильно навороченных выборах/отметках/вводах может быть полезно. Одно меня смущает - нет ли какого-нибудь небесконечного предела при операции создании/удалении листа. Помнится, что-то такое есть при создании копии листа, типа не более 8 тысяч раз с хвостиком, что ли...
P.S. Наконец понял эти великие слова про фильтр: сначала надо ShowAllData и только потом Rows.Count с End(xlUp). Меняю под спойлером, а в файле уже лениво, гы-гы.
Gustav, классно, но тоже сперва нужно снять фильтры...
Hugo, Игорь, так я там, вроде, снимаю, в смысле снимаете вы с nilem, а я у вас передираю А так любопытно, согласись, при не сильно навороченных выборах/отметках/вводах может быть полезно. Одно меня смущает - нет ли какого-нибудь небесконечного предела при операции создании/удалении листа. Помнится, что-то такое есть при создании копии листа, типа не более 8 тысяч раз с хвостиком, что ли...
P.S. Наконец понял эти великие слова про фильтр: сначала надо ShowAllData и только потом Rows.Count с End(xlUp). Меняю под спойлером, а в файле уже лениво, гы-гы.Gustav
...что б у выбранных товарищей в столбце F вместо "пв" появлялось "о"
попробуйте так: [vba]
Код
Private Sub CommandButton1_Click() 'Ok button Dim i& If ListBox1.ListIndex = -1 Then MsgBox "Nothing", 64: Exit Sub With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then Cells(.List(i, 1), 6) = "î" Next i End With Unload Me End Sub
[/vba] в файле - зеленая кнопка с Dialog Sheet - интересная вещь.
...что б у выбранных товарищей в столбце F вместо "пв" появлялось "о"
попробуйте так: [vba]
Код
Private Sub CommandButton1_Click() 'Ok button Dim i& If ListBox1.ListIndex = -1 Then MsgBox "Nothing", 64: Exit Sub With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) Then Cells(.List(i, 1), 6) = "î" Next i End With Unload Me End Sub
[/vba] в файле - зеленая кнопка с Dialog Sheet - интересная вещь.nilem
Все дело в массиве Х в Private Sub UserForm_Initialize() вот здесь [vba]
Код
With ActiveSheet If .FilterMode Then .ShowAllData x = .Range("A5:F" & .Cells(Rows.Count, 1).End(xlUp).Row).Value End With
[/vba] мы переносим в массив Х значения из диапазона ячеек A5:F57 (нижняяя граница определяется динамически)
а в этом цикле заполняем выходной массив y (который потом станет списком для Листбокса): [vba]
Код
For i = 1 To UBound(x) If x(i, 6) = "пв" Then k = k + 1 y(1, k) = x(i, 1) y(2, k) = i + 4 End If Next i
[/vba] смотрим строчку y(1, k) = x(i, 1), где x(i, 1) - это элемент массива на пересечении i-той строки и 1-го солбца (там, где ФИО полностью) если нужна только фамилия, то это будет x(i, 2); если только отчество, то x(i, 4)
Все дело в массиве Х в Private Sub UserForm_Initialize() вот здесь [vba]
Код
With ActiveSheet If .FilterMode Then .ShowAllData x = .Range("A5:F" & .Cells(Rows.Count, 1).End(xlUp).Row).Value End With
[/vba] мы переносим в массив Х значения из диапазона ячеек A5:F57 (нижняяя граница определяется динамически)
а в этом цикле заполняем выходной массив y (который потом станет списком для Листбокса): [vba]
Код
For i = 1 To UBound(x) If x(i, 6) = "пв" Then k = k + 1 y(1, k) = x(i, 1) y(2, k) = i + 4 End If Next i
[/vba] смотрим строчку y(1, k) = x(i, 1), где x(i, 1) - это элемент массива на пересечении i-той строки и 1-го солбца (там, где ФИО полностью) если нужна только фамилия, то это будет x(i, 2); если только отчество, то x(i, 4)nilem