Алекс, привет! а у меня вот так получилось (используем Tag формы)
[vba]
Код
Option Explicit
'Public RET_Val ' переменная для возврата данных из временной UserForm
Sub test_LstBox() ' тестирование LstBox On Error Resume Next Dim x Set x = ActiveWorkbook.VBProject ' проверка доступности .VBProject If Err Then MsgBox "Настройки безопасности не позволяют выполнить макрос", vbCritical: Exit Sub On Error GoTo 0
MsgBox LstBox(GetListItems, "Select Item")
'If VarType(RET_Val) = vbBoolean Then MsgBox "Item Not Selected!", vbCritical: Exit Sub ' если нажали "Отмена", то Ret_Val = False End Sub
Private Function GetListItems() ' получить массив значений для заполнения ListBox Dim xVal With CreateObject("Scripting.Dictionary"): .CompareMode = vbTextCompare ' Создаем словарь .Add ">> " & ActiveSheet.Name & " <<", "" ' текущий документ первый в списке For Each xVal In ActiveWorkbook.Worksheets .Add xVal.Name, "" Next xVal ' другие открытые документы .Add "<< " & "New Document" & " >>", "" GetListItems = .Keys ' массив ключей копируем в массив (напрямую читать из .Keys нельзя) End With End Function
Private Function LstBox(Arr, Title$) As String ' создание, вывод и удаление временной UserForm с ListBox Dim oFrm, oListBox Dim oDoc: Set oDoc = ThisWorkbook ' в других объектных моделях необходимо назначить соответствующие объекты (в Visio - ThisDocument) Dim sCodeStr$ sCodeStr = "Private Sub UserForm_Initialize()" & vbCrLf & _ " With Me.ListBox1" & vbCrLf & _ " .Top = Me.Top: .Left = Me.Left" & vbCrLf & _ " .Height = Me.Height: .Width = Me.Width" & vbCrLf & _ " .List = Split(.Tag, ""||""): .Tag = """" ' заполнить списком, переданным в ListBox1.Tag" & vbCrLf & _ " End With" & vbCrLf & _ "End Sub" & vbCrLf & _ vbCrLf & _ "Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)" & vbCrLf & _ " Me.Tag = Me.ListBox1.Text: Me.Hide ' Unload Me" & vbCrLf & _ "End Sub" Set oFrm = oDoc.VBProject.VBComponents.Add(3) ' vbext_ct_StdModule == 1 , vbext_ct_ClassModule == 2 , vbext_ct_MSForm == 3 With oFrm .Properties("Width") = 350 ' или .Properties(42) .Properties("Height") = 150 ' или .Properties(43) Set oListBox = .Designer.Controls.Add("Forms.Listbox.1") oListBox.Tag = Join(Arr, "||") 'передача списка в форму через параметр ListBox.Tag
With .CodeModule .InsertLines .CountOfDeclarationLines + 1, sCodeStr End With ' без With … End With, почему-то не работает VBA.UserForms.Add(.Name).Show
End With oDoc.VBProject.VBComponents.Remove VBComponent:=oFrm ' удаление созданной временной формы End Function
[/vba]
Алекс, привет! а у меня вот так получилось (используем Tag формы)
[vba]
Код
Option Explicit
'Public RET_Val ' переменная для возврата данных из временной UserForm
Sub test_LstBox() ' тестирование LstBox On Error Resume Next Dim x Set x = ActiveWorkbook.VBProject ' проверка доступности .VBProject If Err Then MsgBox "Настройки безопасности не позволяют выполнить макрос", vbCritical: Exit Sub On Error GoTo 0
MsgBox LstBox(GetListItems, "Select Item")
'If VarType(RET_Val) = vbBoolean Then MsgBox "Item Not Selected!", vbCritical: Exit Sub ' если нажали "Отмена", то Ret_Val = False End Sub
Private Function GetListItems() ' получить массив значений для заполнения ListBox Dim xVal With CreateObject("Scripting.Dictionary"): .CompareMode = vbTextCompare ' Создаем словарь .Add ">> " & ActiveSheet.Name & " <<", "" ' текущий документ первый в списке For Each xVal In ActiveWorkbook.Worksheets .Add xVal.Name, "" Next xVal ' другие открытые документы .Add "<< " & "New Document" & " >>", "" GetListItems = .Keys ' массив ключей копируем в массив (напрямую читать из .Keys нельзя) End With End Function
Private Function LstBox(Arr, Title$) As String ' создание, вывод и удаление временной UserForm с ListBox Dim oFrm, oListBox Dim oDoc: Set oDoc = ThisWorkbook ' в других объектных моделях необходимо назначить соответствующие объекты (в Visio - ThisDocument) Dim sCodeStr$ sCodeStr = "Private Sub UserForm_Initialize()" & vbCrLf & _ " With Me.ListBox1" & vbCrLf & _ " .Top = Me.Top: .Left = Me.Left" & vbCrLf & _ " .Height = Me.Height: .Width = Me.Width" & vbCrLf & _ " .List = Split(.Tag, ""||""): .Tag = """" ' заполнить списком, переданным в ListBox1.Tag" & vbCrLf & _ " End With" & vbCrLf & _ "End Sub" & vbCrLf & _ vbCrLf & _ "Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)" & vbCrLf & _ " Me.Tag = Me.ListBox1.Text: Me.Hide ' Unload Me" & vbCrLf & _ "End Sub" Set oFrm = oDoc.VBProject.VBComponents.Add(3) ' vbext_ct_StdModule == 1 , vbext_ct_ClassModule == 2 , vbext_ct_MSForm == 3 With oFrm .Properties("Width") = 350 ' или .Properties(42) .Properties("Height") = 150 ' или .Properties(43) Set oListBox = .Designer.Controls.Add("Forms.Listbox.1") oListBox.Tag = Join(Arr, "||") 'передача списка в форму через параметр ListBox.Tag
With .CodeModule .InsertLines .CountOfDeclarationLines + 1, sCodeStr End With ' без With … End With, почему-то не работает VBA.UserForms.Add(.Name).Show
Привет, Николай! С тэгом формы я пробовал с самого начала. Но какие-то конфликты возникали. Сейчас не помню, но, кажется, тэг у скрытой формы почему-то не хотел то ли задаваться, то ли читаться. Потому и передавать стал данные в тэге листбокса. Завтра на работе покручу твой пример.
Привет, Николай! С тэгом формы я пробовал с самого начала. Но какие-то конфликты возникали. Сейчас не помню, но, кажется, тэг у скрытой формы почему-то не хотел то ли задаваться, то ли читаться. Потому и передавать стал данные в тэге листбокса. Завтра на работе покручу твой пример.Alex_ST
Андрей, [url=https://msdn.microsoft.com/en-us/library/windows/desktop/aa366551(v=vs.85).aspx] Creating Named Shared Memory [/url], конечно, очень мощное решение. Но не получится ли для данного вопроса "из пушки по воробьям"? Ведь транслировать-то нужно мизерные объёмы информации - сотни бит от силы. Можно было бы, наверное, "для эрудиции" и поковыряться с этим вопросом на досуге, но уж никак не по статье на английском и С++ К тому же хотелось бы локализовать весь LstBox в одной процедуре, легко и просто переносимой из документа в документ и из приложения в приложение. [offtop]Размещение процедуры (функции) в надстройке применимо только в ограниченном числе приложений, программируемых на VBA. Например, в Visio, для автоматизации которого я собственно и начал разрабатывать функцию LstBox, нет всегда открываемого при старте приложения документа, аналогичного Personal.xls Excel'я и Normal.dot Word'а. И возможности создавать надстройки там тоже нет Вообще у Visio абсолютно идиотская объектная модель, с которой жутко не удобно работать на VBA [/offtop]
Андрей, [url=https://msdn.microsoft.com/en-us/library/windows/desktop/aa366551(v=vs.85).aspx] Creating Named Shared Memory [/url], конечно, очень мощное решение. Но не получится ли для данного вопроса "из пушки по воробьям"? Ведь транслировать-то нужно мизерные объёмы информации - сотни бит от силы. Можно было бы, наверное, "для эрудиции" и поковыряться с этим вопросом на досуге, но уж никак не по статье на английском и С++ К тому же хотелось бы локализовать весь LstBox в одной процедуре, легко и просто переносимой из документа в документ и из приложения в приложение. [offtop]Размещение процедуры (функции) в надстройке применимо только в ограниченном числе приложений, программируемых на VBA. Например, в Visio, для автоматизации которого я собственно и начал разрабатывать функцию LstBox, нет всегда открываемого при старте приложения документа, аналогичного Personal.xls Excel'я и Normal.dot Word'а. И возможности создавать надстройки там тоже нет Вообще у Visio абсолютно идиотская объектная модель, с которой жутко не удобно работать на VBA [/offtop]Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Среда, 30.11.2016, 09:43
Вот именно этого мне и не хватало!!! Спасибо, Николай! Пришлось, правда, добавить перед этим On Error Resume Next , т.к. если форму закрыть "крестиком", то тэга уже нет и возникает ошибка. Завтра допилю и выложу окончательное отполированное решение. Что-то я запамятовал... Напомните кто-нибудь, пожалуйста, кажется, если оформить файл как надстройку, то объявленная в ней функция Function LstBox(Arr, Title$) по умолчанию станет доступна из всех открытых VBA проектов без указания имени файла и модуля? Или всё-таки нужно её писать как Public Function LstBox(Arr, Title$) ?
Вот именно этого мне и не хватало!!! Спасибо, Николай! Пришлось, правда, добавить перед этим On Error Resume Next , т.к. если форму закрыть "крестиком", то тэга уже нет и возникает ошибка. Завтра допилю и выложу окончательное отполированное решение. Что-то я запамятовал... Напомните кто-нибудь, пожалуйста, кажется, если оформить файл как надстройку, то объявленная в ней функция Function LstBox(Arr, Title$) по умолчанию станет доступна из всех открытых VBA проектов без указания имени файла и модуля? Или всё-таки нужно её писать как Public Function LstBox(Arr, Title$) ?Alex_ST