Как получить переменную из временной формы? - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Как получить переменную из временной формы? - Мир MS Excel

Старая форма входа

Страница 1 из 2 1 2 »
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как получить переменную из временной формы? (Макросы/Sub)

Как получить переменную из временной формы?

Дата: Четверг, 24.11.2016, 10:45 | Сообщение № 1

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Привет, ребята и девчата!
Решил я тут на досуге пополнить свою коллекцию "полезняшек" аналогом 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

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Четверг, 24.11.2016, 11:17

Ответить

СообщениеПривет, ребята и девчата!
Решил я тут на досуге пополнить свою коллекцию "полезняшек" аналогом 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]

Автор - Alex_ST
Дата добавления - 24.11.2016 в 10:45

Дата: Четверг, 24.11.2016, 13:20 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487

Репутация: 86 ±

Замечаний: 0% ±

Excel 2013

а если не sub, a function использовать, и возвращать значение самой функции?

Благими намерениями выстелена дорога в АД.

Ответить

Дата: Четверг, 24.11.2016, 13:29 | Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Да пофигу. Пытался я в процедурах формы назначать параметрам элементов возвращаемые значения.
Но пока форма открыта, она не даёт выполняться следующим после её вызова операциям процедуры.
А как только закрывается, её параметры сбрасываются и присваивать значению функции нечего.
При этом код тормозится даже если форма открыта в не модальном режиме.
Но вообще-то в отлаженном виде это как функция и планировалось для полной аналогии с MsgBox.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Четверг, 24.11.2016, 13:32

Ответить

Дата: Четверг, 24.11.2016, 13:37 | Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487

Репутация: 86 ±

Замечаний: 0% ±

Excel 2013

тогда при закрытии формы, отменить закрытие и скрыть .hide
потом забирать параметр, присваивать его функции, а после уже унлодить форму...

Благими намерениями выстелена дорога в АД.

Ответить

Дата: Четверг, 24.11.2016, 14:01 | Сообщение № 5

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Там и так [vba]

Код

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
RET_Val = Me.ListBox1.Text: Me.Hide ' Unload Me
End Sub

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Четверг, 24.11.2016, 14:59 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 190

Репутация: 37 ±

Замечаний: 0% ±

Excel 2010

Alex_ST, Посмотрите ТУТ может подойдет

Ответить

Дата: Четверг, 24.11.2016, 15:19 | Сообщение № 7

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Спасибо. Посмотрел. Но там в модуле класса в декларациях сразу объявляются Public-переменные:[vba]

Код

Public maForm As Object                    'Userform
Public WithEvents Bouton As MSForms.CommandButton              'Button
Public Dico As Object                    'Objet Dictionnary = Object collection

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Пятница, 25.11.2016, 02:26 | Сообщение № 8

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

А если его записать в пользовательское свойство документа, а потом считать оттуда и удалить?
[vba]

Код

Sub tt()
    RET_Val = 4
    ActiveWorkbook.CustomDocumentProperties.Add "aaa", False, msoPropertyTypeString, RET_Val
End Sub

Sub rr()
    For Each cdp In ActiveWorkbook.CustomDocumentProperties
        If cdp.Name = "aaa" Then
            RET_Val = cdp.Value
            cdp.Delete
        End If
    Next
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Пятница, 25.11.2016, 11:56 | Сообщение № 9

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Привет, Саша!
Про пользовательские свойства я, естественно, уже подумал, а потом передумал

и написал:

Цитата Alex_ST, 24.11.2016 в 10:45, в сообщении № 1

НЕЛЬЗЯ ИСПОЛЬЗОВАТЬ … DocumentProperty (чтобы не трудно было адаптировать к другим объектным моделям)

Если уж использовать, то лучше, наверное, что-то более глобальное, не привязанное к приложению.
Сейчас немного дела разгребу (чуть-чуть уже осталось) и посмотрю, как можно использовать переменные окружения файловой системы.
Где-то я это уже видел, поробовал и в заначку, скорее всего, спрятал... Вот теперь бы найти в какой из заначек заначил?

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Пятница, 25.11.2016, 12:02 | Сообщение № 10

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Вот, нагуглил: первая же ссылка - на сайт к Игорю на Получение списка переменных окружения (функция ENVIRON в VBA)
Будем изучать.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Пятница, 25.11.2016, 13:24 | Сообщение № 11

Группа: Друзья

Ранг: Старожил

Сообщений: 1588

Репутация: 192 ±

Замечаний: 0% ±

Excel 2016 х 64

Может функцию со статичными переменными использовать, где первым параметром устанавливать режим (чтение/запись), а второй параметр - значение.
[vba]

Код

Public Function workshop(setP As Boolean, Optional lNum As Long = 0) As Long
Static num As Long
If setP Then num = lNum

workshop = num
End Function

[/vba]

К сообщению приложен файл: 0t.xlsm (16.5 Kb)

вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com

Сообщение отредактировал Udik - Пятница, 25.11.2016, 13:25

Ответить

Дата: Пятница, 25.11.2016, 13:56 | Сообщение № 12

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Евгений, я не понял, при чем здесь это?
Качать файлы с макросами я с работы не могу, поэтому сужу по приведённому тексту процедуры :'(

:'(

Я и так свою функцию LstBox(<Items As Array>, <Header As String>) собрался делать Public
Вся проблема в том, чтобы научиться без использования Public-переменных передавать данные в создаваемую форму и получать их обратно.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Пятница, 25.11.2016, 13:57

Ответить

Дата: Пятница, 25.11.2016, 14:28 | Сообщение № 13

Группа: Друзья

Ранг: Старожил

Сообщений: 1588

Репутация: 192 ±

Замечаний: 0% ±

Excel 2016 х 64

Цитата Alex_ST, 25.11.2016 в 13:56, в сообщении № 12

без использования Public-переменных

А где там Public переменные? Я так понимаю, что Public переменные это котрые объявляются в стандартных модулях вне процедур/функций. Но может Вы что-то другое подразумеваете.

вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com

Ответить

Дата: Пятница, 25.11.2016, 15:20 | Сообщение № 14

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 898 ±

Замечаний: 0% ±

Excel 2010, 2016

Наверное, Евгений хотел что-то вроде этого предложить

[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

ЯД: 410013299366744 WM: R193491431804

Ответить

СообщениеНаверное, Евгений хотел что-то вроде этого предложить

[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]

Автор - Manyasha
Дата добавления - 25.11.2016 в 15:20

Дата: Пятница, 25.11.2016, 19:15 | Сообщение № 15

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Manyasha, спасибо за разъяснения. Со Static я, к стыду своему, никогда не работал. Надо будет попробовать Ваш пример.
Но, к сожалению, попробовать смогу только в понедельник - все наработки осмтались на работе

Я вообще-то папку с тестами держу на гугл-диске. В ней и ковыряю файлы.
Думал, дома включу комп и всё засинхронизируется... Фиг Вам! Синзронизация не отработала. И, похоже, уже дня три-четыре как не работает. Поэтому на домашнем компе тех файлов, с которыми работал на работе, нет вообще! Зараза! Обидно... Руки чешутся попробовать.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Вторник, 29.11.2016, 09:26 | Сообщение № 16

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Поковырял вариант с использованием Static для передачи данных...
Всё-таки это "костыль", т.к. по сути Function getItemListBox является аналогом объявления Public-переменной, но объявленной не в декларациях модуля, а в процедурах.
Есть задумка для передачи использовать переменные окружения форточек.
Работать с ними, оказывается, не сложно.
Правда, возник вопрос по длительности операций создания-чтения-удаления переменных окружения, но обсуждение этого здесь будет оффтопом. Поэтому для разборок с указанным вопросом я создал новый топик: Работа с переменными окружения Windows
Разберусь там, тогда сюда и выложу окончательное решение.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Вторник, 29.11.2016, 09:27

Ответить

Дата: Вторник, 29.11.2016, 13:25 | Сообщение № 17

Группа: Друзья

Ранг: Старожил

Сообщений: 1588

Репутация: 192 ±

Замечаний: 0% ±

Excel 2016 х 64

Почитал новую тему, если надо передавать данные между приложениями, можно тупо текстовый файл использовать

вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com

Ответить

Дата: Вторник, 29.11.2016, 13:37 | Сообщение № 18

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3206

Репутация: 609 ±

Замечаний: 0% ±

2003

Евгений, я надеялся, что тупо создавать, читать, удалять текстовой файл, будет дольше, чем назначить переменную ...

По логике так и должно было быть... Но, похоже, что логика в форточках работает не всегда shock

shock

К стати, пробовал запустить пример оттуда? Тоже время большое и сильно разное?

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Вторник, 29.11.2016, 14:13 | Сообщение № 19

Группа: Друзья

Ранг: Старожил

Сообщений: 1588

Репутация: 192 ±

Замечаний: 0% ±

Excel 2016 х 64

Не, пока близко не занимался.

вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com

Ответить

Дата: Вторник, 29.11.2016, 16:41 | Сообщение № 20

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 190

Репутация: 37 ±

Замечаний: 0% ±

Excel 2010

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

[/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

[/vba]miver

Ответить

Сообщение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

[/vba]

Автор - miver
Дата добавления - 29.11.2016 в 16:41

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как получить переменную из временной формы? (Макросы/Sub)

Страница 1 из 2
1
2
»

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!