Excel VBA 遍历文本框多行中的每一行

Question

我有一个多行文本框（可以按 Enter 键），我想遍历每一行并获取整行文本。

请注意，文本框自动换行已启用，如果通过自动换行创建的新行将类似于新行 (chr(10))，换句话说，我需要抓取每一行文本显示在屏幕上，无论是按“Enter”键创建的新行还是只是文本换行创建的新行都没有关系。

我需要像这样的伪代码：

for each line in textbox
       Debug.Pring line
next

Answer 1

对于用户按下“enter”的部分，这很简单。一个简单的 Debug.Print TextBox1.Text 应该按原样打印它。
如果你不想做伪代码，你可以选择

tbText = Split(TextBox1.Text, vbNewLine)
For Each Line In tbText
    Debug.Print Line
Next

然而，这两个都无法检测到自动换行。

我从那里得到了一个有点老套的方法我使用隐藏的文本框，使代码更简单。

所以我创建了另一个文本框，命名为measure，设置AutoSize = True，WordWrap = False，Visible = False 然后将字体选项设置为与第一个文本框相同。并使用了以下代码：

Dim i As Long, w As Double, num As Long, memory As String
w = TextBox1.Width
tbText = Split(TextBox1.Text, vbNewLine)
For Each Line In tbText
    measure.Text = Line
    If measure.Width > w Then
shorten:
        memory = measure.Text
        While measure.Width > w
            num = InStrRev(measure.Text, " ")
            measure.Text = Left(measure.Text, num - 1)
            i = Len(memory) - num
        Wend
        Debug.Print measure.Text
        measure.Text = Right(Line, i)
        If measure.Width > w Then
            GoTo shorten
        Else
            Debug.Print measure.Text
        End If
    Else
        Debug.Print Line
    End If
Next

但是您可以随意使用任何其他方法来获取此代码的文本宽度，或者使用 Tim 评论的 Link 中的方法。

Answer 2

GetLines 函数创建一个数组，其中数组的每个元素都是传递给函数的 TextBox 中的一行。我决定删除控制字符，但如果不需要，您可以轻松更改逻辑。

捕获 GetLines return 值允许您循环遍历结果：

Option Explicit

Private Sub UserForm_Initialize()
   Text1.Text = "This is line 1" & vbNewLine & "This is a long line that will wrap"
End Sub

Private Sub Command1_Click()
   Dim lines() As String
   Dim line As Variant
   
   lines = GetLines(Text1)
   
   For Each line In lines
      Debug.Print line
   Next
End Sub

Private Function GetLines(ByVal tb As MSForms.TextBox) As String()
   Dim i As Integer
   Dim lc As Integer
   Dim c As String
   Dim lines() As String
   
   tb.SetFocus
   
   lc = 0
   ReDim lines(0 To tb.lineCount - 1)

   For i = 0 To Len(tb.Text) - 1
      tb.SelStart = i
      c = Mid(tb.Text, i + 1, 1)
      If Asc(c) >= 32 Then lines(lc) = lines(lc) & c
      If tb.CurLine > lc Then lc = lc + 1
   Next
   
   GetLines = lines
End Function

Excel VBA 遍历文本框多行中的每一行

Excel VBA loop through every row in Textbox multiline

excel

vba

userform