Привет, ребята и девчата! Решил я тут на досуге пополнить свою коллекцию "полезняшек" аналогом MsgBox, но ListBox, которому список передаётся массивом, а выбор из списка производится по DblClick В итоге я хочу сделать надстройку с Public-функцией LstBox, применяемой точно так же "легко и просто" как и MsgBox. В дальнейшем есть желание дополнить этой фенечкой ещё и Visio с его абсолютно идиотской объектной моделью. В общем решил я программно создавать UserForm с ListBox на ней. Это в принципе не сложно и хорошо описано, например, у Уокенбаха. Основная проблема оказалась в том, как передавать форме массив и как получать обратно выбранное в лист-боксе значение. Главная засада - это то, что НЕЛЬЗЯ ИСПОЛЬЗОВАТЬ Public-переменные (чтобы их не приходилось объявлять в модулях), ячейки листов Excel и DocumentProperty (чтобы не трудно было адаптировать к другим объектным моделям). Ну, с передачей массива в программно создаваемую форму из вызывающей процедуры я проблему решил - передаю массив в форму через параметр .Tag создаваемого на ней ListBox А вот как получить обратно? Полный затык Пока сделал с Public-переменной. Это-то работает отлично. А вот как без неё обойтись? Есть идеи? У меня пока никаких мыслей, кроме как попытаться заюзать переменные среды Форточек, но я с ними плохо умею работать... В выложенном примере для тестирования "фенечки" я вывожу список листов активной книги. Я с работы файлы с макросами выкладывать не могу (собаки-сисадмины ), поэтому выкладываю текстом. Но его можно для тестирования вставить в стандартный модуль любой книги
[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 Call LstBox(GetListItems, "Select Item") If VarType(RET_Val) = vbBoolean Then MsgBox "Item Not Selected!", vbCritical: Exit Sub ' если нажали "Отмена", то Ret_Val = False MsgBox RET_Val 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 Sub LstBox(Arr, Title$) ' создание, вывод и удаление временной UserForm с ListBox Dim oFrm, oListBox Dim oDoc: Set oDoc = ThisWorkbook ' в других объектных моделях необходимо назначить соответствующие объекты (в Visio - ThisDocument) Dim sCodeStr$ sCodeStr = "Private Sub UserForm_Initialize()" & vbCrLf & _ " Ret_Val = False" & 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 & _ " Ret_Val = 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 .CountOfLines + 1, sCodeStr: End With ' без With … End With, почему-то не работает 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 Sub
[/vba]
Привет, ребята и девчата! Решил я тут на досуге пополнить свою коллекцию "полезняшек" аналогом MsgBox, но ListBox, которому список передаётся массивом, а выбор из списка производится по DblClick В итоге я хочу сделать надстройку с Public-функцией LstBox, применяемой точно так же "легко и просто" как и MsgBox. В дальнейшем есть желание дополнить этой фенечкой ещё и Visio с его абсолютно идиотской объектной моделью. В общем решил я программно создавать UserForm с ListBox на ней. Это в принципе не сложно и хорошо описано, например, у Уокенбаха. Основная проблема оказалась в том, как передавать форме массив и как получать обратно выбранное в лист-боксе значение. Главная засада - это то, что НЕЛЬЗЯ ИСПОЛЬЗОВАТЬ Public-переменные (чтобы их не приходилось объявлять в модулях), ячейки листов Excel и DocumentProperty (чтобы не трудно было адаптировать к другим объектным моделям). Ну, с передачей массива в программно создаваемую форму из вызывающей процедуры я проблему решил - передаю массив в форму через параметр .Tag создаваемого на ней ListBox А вот как получить обратно? Полный затык Пока сделал с Public-переменной. Это-то работает отлично. А вот как без неё обойтись? Есть идеи? У меня пока никаких мыслей, кроме как попытаться заюзать переменные среды Форточек, но я с ними плохо умею работать... В выложенном примере для тестирования "фенечки" я вывожу список листов активной книги. Я с работы файлы с макросами выкладывать не могу (собаки-сисадмины ), поэтому выкладываю текстом. Но его можно для тестирования вставить в стандартный модуль любой книги
[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 Call LstBox(GetListItems, "Select Item") If VarType(RET_Val) = vbBoolean Then MsgBox "Item Not Selected!", vbCritical: Exit Sub ' если нажали "Отмена", то Ret_Val = False MsgBox RET_Val 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 Sub LstBox(Arr, Title$) ' создание, вывод и удаление временной UserForm с ListBox Dim oFrm, oListBox Dim oDoc: Set oDoc = ThisWorkbook ' в других объектных моделях необходимо назначить соответствующие объекты (в Visio - ThisDocument) Dim sCodeStr$ sCodeStr = "Private Sub UserForm_Initialize()" & vbCrLf & _ " Ret_Val = False" & 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 & _ " Ret_Val = 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 .CountOfLines + 1, sCodeStr: End With ' без With … End With, почему-то не работает 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 Sub
Да пофигу. Пытался я в процедурах формы назначать параметрам элементов возвращаемые значения. Но пока форма открыта, она не даёт выполняться следующим после её вызова операциям процедуры. А как только закрывается, её параметры сбрасываются и присваивать значению функции нечего. При этом код тормозится даже если форма открыта в не модальном режиме. Но вообще-то в отлаженном виде это как функция и планировалось для полной аналогии с MsgBox.
Да пофигу. Пытался я в процедурах формы назначать параметрам элементов возвращаемые значения. Но пока форма открыта, она не даёт выполняться следующим после её вызова операциям процедуры. А как только закрывается, её параметры сбрасываются и присваивать значению функции нечего. При этом код тормозится даже если форма открыта в не модальном режиме. Но вообще-то в отлаженном виде это как функция и планировалось для полной аналогии с MsgBox.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Четверг, 24.11.2016, 13:32
Спасибо. Посмотрел. Но там в модуле класса в декларациях сразу объявляются Public-переменные:[vba]
Код
Public maForm As Object 'Userform Public WithEvents Bouton As MSForms.CommandButton 'Button Public Dico As Object 'Objet Dictionnary = Object collection
[/vba]
Спасибо. Посмотрел. Но там в модуле класса в декларациях сразу объявляются Public-переменные:[vba]
Код
Public maForm As Object 'Userform Public WithEvents Bouton As MSForms.CommandButton 'Button Public Dico As Object 'Objet Dictionnary = Object collection
НЕЛЬЗЯ ИСПОЛЬЗОВАТЬ … DocumentProperty (чтобы не трудно было адаптировать к другим объектным моделям)
Если уж использовать, то лучше, наверное, что-то более глобальное, не привязанное к приложению. Сейчас немного дела разгребу (чуть-чуть уже осталось) и посмотрю, как можно использовать переменные окружения файловой системы. Где-то я это уже видел, поробовал и в заначку, скорее всего, спрятал... Вот теперь бы найти в какой из заначек заначил?
Привет, Саша! Про пользовательские свойства я, естественно, уже подумал, а потом передумал и написал:
НЕЛЬЗЯ ИСПОЛЬЗОВАТЬ … DocumentProperty (чтобы не трудно было адаптировать к другим объектным моделям)
Если уж использовать, то лучше, наверное, что-то более глобальное, не привязанное к приложению. Сейчас немного дела разгребу (чуть-чуть уже осталось) и посмотрю, как можно использовать переменные окружения файловой системы. Где-то я это уже видел, поробовал и в заначку, скорее всего, спрятал... Вот теперь бы найти в какой из заначек заначил? Alex_ST
Евгений, я не понял, при чем здесь это? Качать файлы с макросами я с работы не могу, поэтому сужу по приведённому тексту процедуры Я и так свою функцию LstBox(<Items As Array>, <Header As String>) собрался делать Public Вся проблема в том, чтобы научиться без использования Public-переменных передавать данные в создаваемую форму и получать их обратно.
Евгений, я не понял, при чем здесь это? Качать файлы с макросами я с работы не могу, поэтому сужу по приведённому тексту процедуры Я и так свою функцию LstBox(<Items As Array>, <Header As String>) собрался делать Public Вся проблема в том, чтобы научиться без использования Public-переменных передавать данные в создаваемую форму и получать их обратно.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Пятница, 25.11.2016, 13:57
А где там Public переменные? Я так понимаю, что Public переменные это котрые объявляются в стандартных модулях вне процедур/функций. Но может Вы что-то другое подразумеваете.
А где там Public переменные? Я так понимаю, что Public переменные это котрые объявляются в стандартных модулях вне процедур/функций. Но может Вы что-то другое подразумеваете.Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Наверное, Евгений хотел что-то вроде этого предложить [vba]
Код
Option Explicit Sub test_LstBox() ' тестирование LstBox Dim RET_Val On Error Resume Next Dim x: Set x = ActiveWorkbook.VBProject ' проверка доступности .VBProject If Err Then MsgBox "Настройки безопасности не позволяют выполнить макрос", vbCritical: Exit Sub On Error GoTo 0 Call LstBox(GetListItems, "Select Item") '-------Добавила--------- RET_Val = getItemListBox If RET_Val = "null" Then MsgBox "Item Not Selected!", vbCritical: Exit Sub ' если нажали "Отмена", то Ret_Val = False MsgBox RET_Val 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 Sub LstBox(Arr, Title$) ' создание, вывод и удаление временной UserForm с ListBox Dim oFrm, oListBox Dim oDoc: Set oDoc = ThisWorkbook ' в других объектных моделях необходимо назначить соответствующие объекты (в Visio - ThisDocument) Dim sCodeStr$ '-------Добавила вызов getItemListBox--------- sCodeStr = "Private Sub UserForm_Initialize()" & vbCrLf & _ " getItemListBox ""null""" & 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 & _ " getItemListBox 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 .CountOfLines + 1, sCodeStr: End With ' без With … End With, почему-то не работает 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 Sub '-------Добавила--------- Function getItemListBox(Optional txtItem = "") As String Static result If txtItem <> "" Then result = txtItem getItemListBox = result End Function
[/vba]
Наверное, Евгений хотел что-то вроде этого предложить [vba]
Код
Option Explicit Sub test_LstBox() ' тестирование LstBox Dim RET_Val On Error Resume Next Dim x: Set x = ActiveWorkbook.VBProject ' проверка доступности .VBProject If Err Then MsgBox "Настройки безопасности не позволяют выполнить макрос", vbCritical: Exit Sub On Error GoTo 0 Call LstBox(GetListItems, "Select Item") '-------Добавила--------- RET_Val = getItemListBox If RET_Val = "null" Then MsgBox "Item Not Selected!", vbCritical: Exit Sub ' если нажали "Отмена", то Ret_Val = False MsgBox RET_Val 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 Sub LstBox(Arr, Title$) ' создание, вывод и удаление временной UserForm с ListBox Dim oFrm, oListBox Dim oDoc: Set oDoc = ThisWorkbook ' в других объектных моделях необходимо назначить соответствующие объекты (в Visio - ThisDocument) Dim sCodeStr$ '-------Добавила вызов getItemListBox--------- sCodeStr = "Private Sub UserForm_Initialize()" & vbCrLf & _ " getItemListBox ""null""" & 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 & _ " getItemListBox 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 .CountOfLines + 1, sCodeStr: End With ' без With … End With, почему-то не работает 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 Sub '-------Добавила--------- Function getItemListBox(Optional txtItem = "") As String Static result If txtItem <> "" Then result = txtItem getItemListBox = result End Function
Manyasha, спасибо за разъяснения. Со Static я, к стыду своему, никогда не работал. Надо будет попробовать Ваш пример. Но, к сожалению, попробовать смогу только в понедельник - все наработки осмтались на работе Я вообще-то папку с тестами держу на гугл-диске. В ней и ковыряю файлы. Думал, дома включу комп и всё засинхронизируется... Фиг Вам! Синзронизация не отработала. И, похоже, уже дня три-четыре как не работает. Поэтому на домашнем компе тех файлов, с которыми работал на работе, нет вообще! Зараза! Обидно... Руки чешутся попробовать.
Manyasha, спасибо за разъяснения. Со Static я, к стыду своему, никогда не работал. Надо будет попробовать Ваш пример. Но, к сожалению, попробовать смогу только в понедельник - все наработки осмтались на работе Я вообще-то папку с тестами держу на гугл-диске. В ней и ковыряю файлы. Думал, дома включу комп и всё засинхронизируется... Фиг Вам! Синзронизация не отработала. И, похоже, уже дня три-четыре как не работает. Поэтому на домашнем компе тех файлов, с которыми работал на работе, нет вообще! Зараза! Обидно... Руки чешутся попробовать.Alex_ST
Поковырял вариант с использованием Static для передачи данных... Всё-таки это "костыль", т.к. по сути Function getItemListBox является аналогом объявления Public-переменной, но объявленной не в декларациях модуля, а в процедурах. Есть задумка для передачи использовать переменные окружения форточек. Работать с ними, оказывается, не сложно. Правда, возник вопрос по длительности операций создания-чтения-удаления переменных окружения, но обсуждение этого здесь будет оффтопом. Поэтому для разборок с указанным вопросом я создал новый топик: Работа с переменными окружения Windows Разберусь там, тогда сюда и выложу окончательное решение.
Поковырял вариант с использованием Static для передачи данных... Всё-таки это "костыль", т.к. по сути Function getItemListBox является аналогом объявления Public-переменной, но объявленной не в декларациях модуля, а в процедурах. Есть задумка для передачи использовать переменные окружения форточек. Работать с ними, оказывается, не сложно. Правда, возник вопрос по длительности операций создания-чтения-удаления переменных окружения, но обсуждение этого здесь будет оффтопом. Поэтому для разборок с указанным вопросом я создал новый топик: Работа с переменными окружения Windows Разберусь там, тогда сюда и выложу окончательное решение.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Вторник, 29.11.2016, 09:27
Евгений, я надеялся, что тупо создавать, читать, удалять текстовой файл, будет дольше, чем назначить переменную ... По логике так и должно было быть... Но, похоже, что логика в форточках работает не всегда К стати, пробовал запустить пример оттуда? Тоже время большое и сильно разное?
Евгений, я надеялся, что тупо создавать, читать, удалять текстовой файл, будет дольше, чем назначить переменную ... По логике так и должно было быть... Но, похоже, что логика в форточках работает не всегда К стати, пробовал запустить пример оттуда? Тоже время большое и сильно разное?Alex_ST
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 Call LstBox(GetListItems, "Select Item") 'If VarType(RET_Val) = vbBoolean Then MsgBox "Item Not Selected!", vbCritical: Exit Sub ' если нажали "Отмена", то Ret_Val = False If Err Then MsgBox Err.Description Err.Clear Else MsgBox "Item Not Selected!", vbCritical: Exit Sub End If 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 Sub LstBox(Arr, Title$) ' создание, вывод и удаление временной UserForm с ListBox Dim oFrm, oListBox Dim oDoc: Set oDoc = ThisWorkbook ' в других объектных моделях необходимо назначить соответствующие объекты (в Visio - ThisDocument) Dim sCodeStr$ sCodeStr = "Private Sub UserForm_Initialize()" & vbCrLf & _ " Ret_Val = False" & 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 & _ " On Error Resume Next" & vbCrLf & _ " Err.Raise 1001, ""Module1::Test()"", Me.ListBox1.Text" & vbCrLf & _ " Me.Hide" & 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 .CountOfLines + 1, sCodeStr: End With ' без With … End With, почему-то не работает 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 Sub
[/vba]
Alex_ST, Вот готовое решение [vba]
Код
Option Explicit
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 Call LstBox(GetListItems, "Select Item") 'If VarType(RET_Val) = vbBoolean Then MsgBox "Item Not Selected!", vbCritical: Exit Sub ' если нажали "Отмена", то Ret_Val = False If Err Then MsgBox Err.Description Err.Clear Else MsgBox "Item Not Selected!", vbCritical: Exit Sub End If 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 Sub LstBox(Arr, Title$) ' создание, вывод и удаление временной UserForm с ListBox Dim oFrm, oListBox Dim oDoc: Set oDoc = ThisWorkbook ' в других объектных моделях необходимо назначить соответствующие объекты (в Visio - ThisDocument) Dim sCodeStr$ sCodeStr = "Private Sub UserForm_Initialize()" & vbCrLf & _ " Ret_Val = False" & 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 & _ " On Error Resume Next" & vbCrLf & _ " Err.Raise 1001, ""Module1::Test()"", Me.ListBox1.Text" & vbCrLf & _ " Me.Hide" & 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 .CountOfLines + 1, sCodeStr: End With ' без With … End With, почему-то не работает 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 Sub