Excel VBA - получить двойное нажатие слова в многострочном текстовом поле пользовательской формы

Задача: моя цель - извлечь выделенное слово из многострочного TextBox в UserForm после двойного щелчка.

Используемые свойства: в то время как абсолютно не проблема выделить данную позицию строки через TextBox свойства .SelStart а также .SelLength С другой стороны, это не так просто: пользователи DblClick выделяет целую строку слова, но Excel не сбрасывает .SelStart значение в начальной позиции выделенного текста, как можно предположить, .SelStart значение остается там, где пользователь дважды щелкает.

Мой вопрос: есть ли возможность поймать начальную позицию выделенного текста непосредственно, как это установлено приложением?

Моя работа: я покажу очень простую работу по восстановлению выделенного слова, просто проверив следующие и предшествующие, например, 20 букв вправо и влево на фактическую позицию щелчка (конечно, можно также использовать регулярное выражение и уточнить пример кода):

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim sTxt   As String, sSel As String       ' edited due to comment below
Dim selPos As Long, i As Long, i2 As Long  ' "
TextBox1.SetFocus  
' this is the User's DblClick Position, 
' but not the starting Position of the highlighted Word 
' after DblClick             
selPos = TextBox1.SelStart
sTxt = Replace(Replace(TextBox1.Text, vbCrLf, vbLf), "\", ".")
If TextBox1.SelLength > 0 Then
    sSel = TextBox1.SelText
Else
    sSel = Mid(sTxt, selPos + 1, 5)
    ' check the preceding 20 letters
    i = selPos
    For i = selPos To (selPos - 20) Step -1
        If i < 0 Then Exit For
        Select Case Left(Mid(sTxt, i + 1), 1)
          Case " ", vbLf, ":", ".", "?", """", "'", "(", ")"
             sSel = Mid(sTxt, i + 2, selPos - i)
             Exit For  
        End Select
    Next i
    ' check the following 20 letters
    i2 = selPos
    For i2 = selPos To (selPos + 20)
        If i2 > Len(sTxt) Then Exit For
        Select Case Left(Mid(sTxt, i2 + 1), 1)
          Case " ", vbLf, ":", ".", "?", """", "'", ")", "("
             sSel = Replace(Mid(sTxt, i + 2, i2 - i - IIf(i = i2, 0, 1)), vbLf, "")
             Exit For  
        End Select
    Next i2
End If
' Show the highlighted word
Me.Label1.Text = sSel

End Sub

Дополнительные пояснения к найденному решению в модуле кода UserForm (thx @Rory)

Чтобы получить выделенную строку с двойным щелчком мыши из многострочного текстового поля, вам потребуется три шага для решения проблемы синхронизации:

  1. Как свойства позиции текстового поля SelStart а также SelLength еще не установлены в DblClick событие, необходимо назначить True в булеву переменную / маркер (bCheck).
  2. Использовать MouseUp событие, чтобы получить окончательные свойства позиции после проверки bCheck,
  3. Для правильного подсчета необходимо удалить, например, vbLf в паре возврат каретки Chr(13) знак равно vbCr) и переводы строки Chr(10) знак равно vbLf) в системах MS.

    Предупреждение: обратите внимание, что системы AFAIK Mac используют только перевод строки Chr(10) как конечный знак, так что IMO вы можете пропустить замену в этом случае.

Окончательный код

Option Explicit
Private bCheck As Boolean

' [1] assign True to boolean variable
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    bCheck = True       ' set marker to True
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If bCheck Then
        bCheck = False  ' reset marker to False
      ' [2][3] extract the highlighted doubleclicked word from multi-line textbox 
        MsgBox Trim(Mid(Replace(Me.TextBox1.Text, vbLf, ""), Me.TextBox1.SelStart + 1, Me.TextBox1.SelLength))
    End If
End Sub

1 ответ

Решение

Я думаю, что это проблема времени. Кажется, это работает, если вы используете переменную flag и событие MouseUp в сочетании с событием DblClick:

Private bCheck As Boolean

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    bCheck = True
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If bCheck Then
        bCheck = False
        MsgBox Me.TextBox1.SelStart & "; " & Me.TextBox1.SelLength
    End If
End Sub
Другие вопросы по тегам