是否可以通过 VBA 代码在包装单元格中插入换行符？ （类似于手动输入数据时做Alt-Enter）
我已通过 VBA 代码将单元格的换行文本属性设置为 True，并且我还通过 VBA 代码将数据插入其中。
【问题讨论】：
是的。 AltEnter 的 VBA 等效项是使用换行符：
ActiveCell.Value = "I am a " & Chr(10) & "test"
请注意，这会自动将 WrapText 设置为 True。
证明：
Sub test()
Dim c As Range
Set c = ActiveCell
c.WrapText = False
MsgBox "Activcell WrapText is " & c.WrapText
c.Value = "I am a " & Chr(10) & "test"
MsgBox "Activcell WrapText is " & c.WrapText
End Sub
【讨论】：
您也可以使用vbCrLf，它对应于Chr(13) & Chr(10)。正如安迪在下面的评论中提到的那样，您最好改用ControlChars.Lf。
【讨论】：
是的，有两种方法可以添加换行符：
在要添加换行符的字符串中使用 VBA vbCrLf 中的现有函数，例如：
将文本变暗为字符串
text = "Hello" & vbCrLf & "World!"
工作表(1).Cells(1, 1) = 文本
使用 Chr() 函数并传递 ASCII 字符 13 和 10 以添加换行符，如下所示：
将文本变暗为字符串
text = "Hello" & Chr(13) & Chr(10) & "World!"
工作表(1).Cells(1, 1) = 文本
在这两种情况下，单元格 (1,1) 或 A1 中的输出都相同。
【讨论】：
我知道这个问题真的很老了，但是由于我有同样的需求，在搜索 SO 和谷歌之后，我找到了一些答案，但没有任何用处。因此，通过这些碎片和叮咬，我提出了我的解决方案，并在这里分享。
要在运行时将文件中的宽度值转换为列宽值（以像素表示），请使用以下计算： =Truncate(((256 * {width} + Truncate(128/{最大数字宽度}))/256)*{最大数字宽度}) 即使它是 Excel 2010 格式，它仍然可以在 Excel 2016 中工作。我很快就能在 Excel 365 上对其进行测试。
编写三个以这种方式工作的递归函数：
Sub SplitLineTest()
Dim TextRange As Range
Set TextRange = FeuilTest.Cells(2, 2)
'Take the text we want to wrap then past it in multi cells
Dim NewText As String
NewText = SetCRtoEOL(TextRange.Value2, TextRange.Font.Name, TextRange.Font.Size, xlWidthToPixs(TextRange.ColumnWidth) - 5) '-5 to take into account 2 white pixels left and right of the text + 1 pixel for the grid
'Copy each of the text lines in an individual cell
Dim ResultArr() As String
ResultArr() = Split(NewText, Chr(10))
TextRange.Offset(2, 0).Resize(UBound(ResultArr) + 1, 1).Value2 = WorksheetFunction.Transpose(ResultArr())
End Sub
Function xlWidthToPixs(ByVal xlWidth As Double) As Long
'Fonction to convert the size of an Excel column width expressed in Excel unit(Range.ColumnWidth) in pixels
'Parameters : - xlWidth : that is the width of the column Excel unit
'Return : - The size of the column in pixels
Dim pxFontWidthMax As Long
'Xl Col sizing is related to workbook default string configuration and depends of the size in pixel from char "0". We need to gather it
With ThisWorkbook.Styles("Normal").Font
pxFontWidthMax = pxGetStringW("0", .Name, .Size) 'Get the size in pixels of the '0' character
End With
'Now, we can make the calculation
xlWidthToPixs = WorksheetFunction.Floor_Precise(((256 * xlWidth + WorksheetFunction.Floor_Precise(128 / pxFontWidthMax)) / 256) * pxFontWidthMax) + 5
End Function
Function SetCRtoEOL(ByVal Original As String, ByVal FontName As String, ByVal FontSize As Variant, ByVal pxAvailW) As String
'Function aiming to make a text fit into a given number of pixels, by putting some CR char between words when needed.
'If some words are too longs to fit in the given width, they won't be cut and will get out of the limits given.
'The function works recursively. Each time it find an End Of Line, it call itself with the remaining text until.
'The recursive process ends whent the text fit in the given space without needing to be truncated anymore
'Parameters : - Original : The text to fit
' - FontName : Name of the font
' - FontSize : Size of the font
' - pxAvailW : Available width in pixels in wich we need to make the text fit
'Return : - The orignal text with CR in place of spaces where the text needs to be cut to fit the width
'If we got a null string, there is nothing to do so we return a null string
If Original = vbNullString Then Exit Function
Dim pxTextW As Long
'If the text fit in, may be it's the original or this is end of recursion. Nothing to do more than returne the text back
pxTextW = pxGetStringW(Original, FontName, FontSize)
If pxTextW < pxAvailW Then
SetCRtoEOL = Original
Exit Function
End If
'The text doesn't fit, we need to find where to cut it
Dim WrapPosition As Long
Dim EstWrapPosition As Long
EstWrapPosition = Len(Original) * pxAvailW / pxTextW 'Estimate the cut position in the string given to a proportion of characters
If pxGetStringW(Left(Original, EstWrapPosition), FontName, FontSize) < pxAvailW Then
'Text to estimated wrap position fits in, we try to see if we can fits some more words
WrapPosition = FindMaxPosition(Original, FontName, FontSize, pxAvailW, EstWrapPosition)
End If
'If WrapPosition = 0, we didn't get a proper place yet, we try to find the previous white space
If WrapPosition = 0 Then
WrapPosition = FindMaxPositionRev(Original, FontName, FontSize, pxAvailW, EstWrapPosition)
End If
'If WrapPosition is still 0, we are facing a too long word for the pxAvailable. We'll cut after this word what ever. (Means we must search for the first white space of the text)
If WrapPosition = 0 Then
WrapPosition = InStr(Original, " ")
End If
If WrapPosition = 0 Then
'Words too long to cut, but nothing more to cut, we return it as is
SetCRtoEOL = Original
Else
'We found a wrap position. We recurse to find the next EOL and construct our response by adding CR in place of the white space
SetCRtoEOL = Left(Original, WrapPosition - 1) & Chr(10) & SetCRtoEOL(Right(Original, Len(Original) - WrapPosition), FontName, FontSize, pxAvailW)
End If
End Function
Function FindMaxPosition(ByVal Text As String, ByVal FontName As String, ByVal FontSize As Variant, ByVal pxAvailW, ByVal WrapPosition As Long) As Long
'Function that finds the maximum number of words fitting in a given space by adding words until it get out of the maximum space
'The function is inteded to work on text with a "guessed" wrap position that fit in the space allowed
'The function is recursive. Each time it guesses a new position and the word still fits in the space, it calls itself with a further WrapPosition
'Parameters : - Text : The text to fit
' - FontName : Name of the font
' - FontSize : Size of the font
' - pxAvailW : Available width in pixels in wich we need to make the text fit
' - WrapPosition : The initial wrap position, positionned someware in the text (WrapPosition < len(Text)) but inside pxAvailW
'Return : - The position were the text must be wraped to put as much words as possible in pxAvailW, but without getting outside of it. If no position can be found, returns 0
Dim NewWrapPosition As Long
Static isNthCall As Boolean
'Find next Whitespace position
NewWrapPosition = InStr(WrapPosition, Text, " ")
If NewWrapPosition = 0 Then Exit Function 'We can't find a wrap position, we return 0
If pxGetStringW(Left(Text, NewWrapPosition - 1), FontName, FontSize) < pxAvailW Then '-1 not to take into account the last white space
'It still fits, we can try on more word
isNthCall = True
FindMaxPosition = FindMaxPosition(Text, FontName, FontSize, pxAvailW, NewWrapPosition + 1)
Else
'It doesnt fit. If it was the first call, we terminate with 0, else we terminate with previous WrapPosition
If isNthCall Then
'Not the first call, we have a position to return
isNthCall = False 'We reset the static to be ready for next call of the function
FindMaxPosition = WrapPosition - 1 'Wrap is at the first letter of the word due to the function call FindMax...(...., NewWrapPosition + 1). The real WrapPosition needs to be minored by 1
Else
'It's the first call, we return 0 | Strictly speaking we can remove this part as FindMaxPosition is already 0, but it make the algo easier to read
FindMaxPosition = 0
End If
End If
End Function
Function FindMaxPositionRev(ByVal Text As String, ByVal FontName As String, ByVal FontSize As Variant, ByVal pxAvailW, ByVal WrapPosition As Long) As Long
'Function working backward of FindMaxPosition. It finds the maximum number of words fitting in a given space by removing words until it fits the given space
'The function is inteded to work on text with a "guessed" wrap position that fit in the space allowed
'The function is recursive. Each time it guesses a new position and the word still doesn't fit in the space, it calls itself with a closer WrapPosition
'Parameters : - Text : The text to fit
' - FontName : Name of the font
' - FontSize : Size of the font
' - pxAvailW : Available width in pixels in wich we need to make the text fit
' - WrapPosition : The initial wrap position, positionned someware in the text (WrapPosition < len(Text)), but outside of pxAvailW
'Return : - The position were the text must be wraped to put as much words as possible in pxAvailW, but without getting outside of it. If no position can be found, returns 0
Dim NewWrapPosition As Long
NewWrapPosition = InStrRev(Text, " ", WrapPosition)
'If we didn't found white space, we are facing a "word" too long to fit pxAvailW, we leave and return 0
If NewWrapPosition = 0 Then Exit Function
If pxGetStringW(Left(Text, NewWrapPosition - 1), FontName, FontSize) >= pxAvailW Then '-1 not to take into account the last white space
'It still doesnt fits, we must try one less word
FindMaxPositionRev = FindMaxPositionRev(Text, FontName, FontSize, pxAvailW, NewWrapPosition - 1)
Else
'It fits, we return the position we found
FindMaxPositionRev = NewWrapPosition
End If
End Function
只要单元格中的文本只有一种字体和一种字体大小，此代码就可以工作。在这里，我假设字体不是粗体也不是斜体，但这可以通过添加一些参数来轻松处理，因为测量字符串长度（以像素为单位）的函数已经能够做到这一点。 我做了很多测试，我总是得到与 Excel 工作表的自动换行功能相同的结果，但它可能因 Excel 版本而异。我认为它适用于 Excel 2010，并且我在 2013 年和 2016 年对其进行了成功测试。对于其他我不知道的人。 如果您需要处理给定单元格内字体类型和/或属性不同的情况，我认为可以通过使用 range.caracters 属性逐个字符地测试单元格中的文本来实现。它应该真的很慢，但就目前而言，即使将文本分成近 200 行，它也只需要不到一秒钟的时间，所以也许它是可行的。
【讨论】：
只需在文本框中执行 Ctrl + Enter
【讨论】：