코드를 통해 줄 바꿈 셀에 줄 바꿈 삽입

코드를 통해 줄 바꿈 셀에 줄 바꿈 삽입

랩된 셀에 VBA 코드를 사용하여 줄 바꿈을 삽입할 수 있습니까?(수동으로 데이터를 입력할 때와 유사)Enter

VBA 코드를 통해 셀의 랩 텍스트 속성을 True로 설정하고 VBA 코드를 통해 데이터를 삽입합니다.

네. 의 VBA는 줄 바꿈 문자를 사용합니다.

ActiveCell.Value = "I am a " & Chr(10) & "test"

이것은 자동적으로 설정됩니다.WrapText정말이에요.

실증:

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)Andy가 아래 댓글에서 언급했듯이, 당신은 그것을 사용하는 것이 더 나을 수 있습니다.ControlChars.Lf대신.

네, 회선 피드를 추가하는 방법에는 다음 두 가지가 있습니다.

1. VBA의 기존 상수 사용(기존 vba 상수 목록을 보려면 여기를 클릭)vbLf다음과 같이 회선 피드를 추가하는 문자열에 입력합니다.

    Dim text As String
    
    text = "Hello" & vbLf & "World!"
    
    Worksheets(1).Cells(1, 1) = text

2. 를 사용합니다.Chr()다음과 같이 ASCII 문자 10을 기능시키고 전달하여 라인 피드를 추가합니다.

    Dim text As String
    
    text = "Hello" & Chr(10) & "World!"
    
    Worksheets(1).Cells(1, 1) = text

어느 경우든 셀(1,1) 또는 A1에 동일한 출력이 있습니다.

상세한 것에 대하여는, 다음의 2개의 스레드를 참조해 주세요.

• "라인 피드"와 "캐리지 리턴"의 차이점은 무엇입니까?
• vbLf, vbCrLf 및 vbCr 상수의 차이

이 질문이 아주 오래된 것은 알지만, 같은 요구를 가지고 있었기 때문에 SO와 구글을 검색해 본 결과, 사용할 수 있는 것은 없었습니다.그 조각들과 물린 부분들로 저는 제가 여기서 공유하는 해결책을 만들었습니다.

필요한 것

1. 열 너비(픽셀) 확인
2. 열의 치수로 잘라내기 위해 문자열의 길이를 픽셀 단위로 측정할 수 있습니다.

발견한 것

1. 열의 폭(픽셀 단위)에 대해 Excel 2010 Document Format에서 확인했습니다.

실행 시 파일의 너비 값을 열 너비 값(픽셀 단위)으로 변환하려면 =Tuncate((256 * {width} + Tuncate(128/{Maximum Digit Width})*{Maximum Digit Width}) Excel 2010 형식이라도 Excel 2016에서 계속 작동합니다.곧 엑셀365와 비교해서 테스트 할 수 있을 것 같습니다.

2. 픽셀 단위의 문자열 폭에 대해서는 이 질문에서 @TravelinGuy가 제안한 솔루션을 사용하여 오타 및 오버플로우를 약간 수정하였습니다.제가 이 글을 쓸 때쯤에는 이미 그의 답변에 오타가 수정되어 있지만, 여전히 오버플로 문제가 있습니다.그럼에도 불구하고 나는 그의 대답에 코멘트를 달았기 때문에 당신은 그것을 완벽하게 작동시킬 수 있는 모든 것이 있습니다.

내가 한 일

코드 3 재귀 함수는 다음과 같이 동작합니다.

1. 기능 1 : 컬럼에 들어갈 수 있도록 문장을 잘라낼 대략적인 위치를 추측하고 기능 2와 3을 호출하여 올바른 위치를 결정합니다.각 행이 열 크기에 맞도록 적절한 위치에 CR(Chr(10) 문자가 포함된 원래 문자열을 반환합니다.
2. 기능 2: 추측된 위치에서 열 크기에 맞게 행에 단어를 추가해 보십시오.
3. [Function 3] : [ Function 2 ]의 정반대입니다.따라서 컬럼사이즈에 맞을 때까지 문장의 단어를 검색합니다.

여기 코드가 있습니다.

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 2010에서 동작한다고 생각하고, 2013년과 2016년에 테스트에 성공했습니다.내가 모르는 다른 사람들.특정 셀 내에서 글꼴 유형 및/또는 속성이 다른 경우 range.caracters 속성을 사용하여 셀 문자의 텍스트를 문자별로 테스트함으로써 이를 달성할 수 있을 것입니다.매우 느릴 것입니다만, 지금으로서는, 텍스트가 거의 200 행으로 분할되어 있어도, 1 초도 걸리지 않기 때문에, 실행 가능한지도 모릅니다.

텍스트 상자 내에서 +만 수행합니다.

언급URL : https://stackoverflow.com/questions/9900916/insert-line-break-in-wrapped-cell-via-code