Meerdere regels in textbox op userform in cel plaatsen

[spaarie]

Helpers,

Wie kan mij helpen met het volgende probleem.

Op mijn userform heb ik een textbox welke uit meerdere regels kan bestaan. Nu wil ik graag dat de opmaak van de cel aangepast wordt zoals in het voorbeeld wanneer ik deze data op het werkblad plaats.
Heeft iemand een suggestie of een oplossing?

Bij voorbaat dank!

 

[Peter B]

Wil je dat de tekst wordt uitgesmeerd door het samenvoegen van cellen (zoals je voorbeeld) of wil je de kolombreedte automatisch zetten?

 

[spaarie]

Uitgesmeerd door cellen samenvoegen
Kolombreedte is (tot op heden) geen optie, omdat de kolommen onder de tekst (waarschijnlijk) wel gebruikt gaan worden.

 

[Peter B]

Hmmmm. Blijft de tekstopmaak hetzelfde?

Dan zou je mogelijk iets kunnen doen door de breedte van de tekst (lengte tekst * gemiddelde breedte per letter) te nemen en dan door de kolommen heen te lopen net zo lang dat de totale kolombreedte groter is dan de breedte van de tekst.

Het kan vast slimmer dan dit, maar het is een eerste aanzet:

Function aantalKolommen(lenTekst As Long, startKolom As Integer) As Long
Dim breedte, teller As Long

teller = startKolom
breedte = Sheets(1).Columns(teller).Width

While breedte < lenTekst
    teller = teller + 1
    breedte = breedte + Sheets(1).Columns(teller).Width
Wend
aantalKolommen = teller

End Function

en

Private Sub CommandButton1_Click()
Dim lengteTekst, aantalRegels As Long
Dim gemBreedte As Double
Dim regel As String

    Sheets(1).Cells(2, 2).Value = TextBox1.Value
    aantalRegels = 1
    tekst = TextBox1.Value
    While InStr(1, tekst, Chr(10), vbTextCompare) > 0
        aantalRegels = aantalRegels + 1
        regel = Mid(tekst, 1, InStr(1, tekst, Chr(10), vbTextCompare))
        tekst = Replace(tekst, regel, "")
        lengteTekst = WorksheetFunction.Max(Len(regel), lengteTekst)
    Wend
    
    gemBreedte = 4.2
        
    Sheets(1).Range(Cells(20, 3), Cells(20, 3 + _
        aantalKolommen(lengteTekst * gemBreedte, 2))).Merge
    
    Sheets(1).Cells(20, 3).Value = TextBox1.Value
    
    Sheets(1).Rows("20:20").RowHeight = Sheets(1).Rows(20).Height * aantalRegels
    
    Unload Me
End Sub

 

[spaarie]

Peter B, bedankt voor je reactie. Ik dacht eigenlijk een simpelere oplossing te krijgen, iets van het aantal Enter-keys * een rijhoogte ofzo.
Ik ga het in eerste instantie wel proberen met grotere kolommen o.i.d, want dit gaat niet werken denk ik.

Bedankt nogmaals voor de moeite en reactie.