Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

= Мир MS Excel/Как получить активный Texbox? - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как получить активный Texbox? (Макросы/Sub)
Как получить активный Texbox?
RAN Дата: Пятница, 20.10.2017, 11:13 | Сообщение № 1
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Мяв!
Нужно по событию в Textbox'e получить ссылку на этот Textbox.
Если он расположен непосредственно на форме, проблем нет.
А как быть, если он на фрейме или мультипейдж?
[vba]
Код
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim x As Object
    Set x = ActiveControl
    Call qq(x)
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim x As Object
    Set x = ActiveControl
    Call qq(x)
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim x As Object
    Set x = ActiveControl
    Call qq(x)
End Sub
Sub qq(x As Object)
    MsgBox x.Name
End Sub
[/vba]
К сообщению приложен файл: tb.xlsm (17.1 Kb)


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеМяв!
Нужно по событию в Textbox'e получить ссылку на этот Textbox.
Если он расположен непосредственно на форме, проблем нет.
А как быть, если он на фрейме или мультипейдж?
[vba]
Код
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim x As Object
    Set x = ActiveControl
    Call qq(x)
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim x As Object
    Set x = ActiveControl
    Call qq(x)
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim x As Object
    Set x = ActiveControl
    Call qq(x)
End Sub
Sub qq(x As Object)
    MsgBox x.Name
End Sub
[/vba]

Автор - RAN
Дата добавления - 20.10.2017 в 11:13
nilem Дата: Пятница, 20.10.2017, 11:25 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
например
[vba]
Код
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Me.Tag = "TextBox1"
    Call qq
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Me.Tag = "TextBox2"
    Call qq
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Me.Tag = "TextBox3"
    Call qq
End Sub
Sub qq()
    MsgBox Me.Tag
End Sub
[/vba]
upd
или вместо Activecontrol пишем Textbox1,2,3 - не пойдет?


Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Пятница, 20.10.2017, 11:29
 
Ответить
Сообщениенапример
[vba]
Код
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Me.Tag = "TextBox1"
    Call qq
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Me.Tag = "TextBox2"
    Call qq
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Me.Tag = "TextBox3"
    Call qq
End Sub
Sub qq()
    MsgBox Me.Tag
End Sub
[/vba]
upd
или вместо Activecontrol пишем Textbox1,2,3 - не пойдет?

Автор - nilem
Дата добавления - 20.10.2017 в 11:25
RAN Дата: Пятница, 20.10.2017, 11:41 | Сообщение № 3
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Нет.
Смысл затеи - вызов процедуры qq единым кодом.
Т.е. копируем 1 код, и вставляем без изменений во все texbox.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеНет.
Смысл затеи - вызов процедуры qq единым кодом.
Т.е. копируем 1 код, и вставляем без изменений во все texbox.

Автор - RAN
Дата добавления - 20.10.2017 в 11:41
Manyasha Дата: Пятница, 20.10.2017, 12:06 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
RAN, нашла тут пример.
Чуть подправила его:
[vba]
Код
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Call fnGetActiveObjectPath
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Call fnGetActiveObjectPath
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Call fnGetActiveObjectPath
End Sub
Sub fnGetActiveObjectPath()
    Dim obj As Object, sPath As String
    sPath = Me.Caption
    Set obj = Me.ActiveControl
    Do
        If obj Is Nothing Then
            sPath = "Nothing"
            Exit Do
        ElseIf TypeOf obj Is MSForms.Frame Or TypeOf obj Is MSForms.Page Then
            sPath = obj.Name
            Set obj = obj.ActiveControl
        ElseIf TypeOf obj Is MSForms.MultiPage Or TypeOf obj Is MSForms.TabStrip Then
            sPath = obj.Name
            Set obj = obj.SelectedItem
        Else ' must be Tab or native control
            sPath = obj.Name
            Exit Do
        End If
    Loop
    MsgBox sPath
End Sub
[/vba]
К сообщению приложен файл: tb-1.xlsm (20.1 Kb)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеRAN, нашла тут пример.
Чуть подправила его:
[vba]
Код
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Call fnGetActiveObjectPath
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Call fnGetActiveObjectPath
End Sub
Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Call fnGetActiveObjectPath
End Sub
Sub fnGetActiveObjectPath()
    Dim obj As Object, sPath As String
    sPath = Me.Caption
    Set obj = Me.ActiveControl
    Do
        If obj Is Nothing Then
            sPath = "Nothing"
            Exit Do
        ElseIf TypeOf obj Is MSForms.Frame Or TypeOf obj Is MSForms.Page Then
            sPath = obj.Name
            Set obj = obj.ActiveControl
        ElseIf TypeOf obj Is MSForms.MultiPage Or TypeOf obj Is MSForms.TabStrip Then
            sPath = obj.Name
            Set obj = obj.SelectedItem
        Else ' must be Tab or native control
            sPath = obj.Name
            Exit Do
        End If
    Loop
    MsgBox sPath
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 20.10.2017 в 12:06
RAN Дата: Пятница, 20.10.2017, 14:53 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Manyasha, Спасибо за идею и ссылку.
В итоге сделал
[vba]
Код
Private Sub TextBox4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    MsgBox GetActiveBox(ActiveControl).Name
End Sub
Function GetActiveBox(oParent As Object) As Object
    Dim oCild As Object
    Static sBoxName$
    sBoxName = ""
    On Error GoTo err_
    If TypeOf oParent Is MSForms.MultiPage Or TypeOf oParent Is MSForms.TabStrip Then
        Set oCild = oParent.SelectedItem
        Call GetActiveBox(oCild)
    ElseIf oParent.Controls.Count Then
        Set oCild = oParent.ActiveControl
        Call GetActiveBox(oCild)
    End If
    Set GetActiveBox = Controls(sBoxName)
    Exit Function
err_:
    If Len(sBoxName) Then Else sBoxName = oParent.Name: Set GetActiveBox = Controls(sBoxName)
End Function
[/vba]
Достает активный Box любой вложенности.
К сообщению приложен файл: 5073798.xlsm (28.9 Kb)


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеManyasha, Спасибо за идею и ссылку.
В итоге сделал
[vba]
Код
Private Sub TextBox4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    MsgBox GetActiveBox(ActiveControl).Name
End Sub
Function GetActiveBox(oParent As Object) As Object
    Dim oCild As Object
    Static sBoxName$
    sBoxName = ""
    On Error GoTo err_
    If TypeOf oParent Is MSForms.MultiPage Or TypeOf oParent Is MSForms.TabStrip Then
        Set oCild = oParent.SelectedItem
        Call GetActiveBox(oCild)
    ElseIf oParent.Controls.Count Then
        Set oCild = oParent.ActiveControl
        Call GetActiveBox(oCild)
    End If
    Set GetActiveBox = Controls(sBoxName)
    Exit Function
err_:
    If Len(sBoxName) Then Else sBoxName = oParent.Name: Set GetActiveBox = Controls(sBoxName)
End Function
[/vba]
Достает активный Box любой вложенности.

Автор - RAN
Дата добавления - 20.10.2017 в 14:53
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как получить активный Texbox? (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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