Automatisk tekstombrydning til x antal tegn.

Nærmeste under eller over 60 tegn?

Nærmeste under 60 tegn.

Måske kan denne makro bruges

Sub LineShift()
Dim C As Range
Dim T As String
Dim Ttemp As String
For Each C In Range("D1:D12").Cells 'her vælges området med oprindelig tekst
Ttemp = C
T = ""
Do Until Len(Ttemp) = 0
If Len(C) < 60 Then
T = T & Ttemp
Ttemp = ""
Else
For x = 60 To 1 Step -1
If Mid(Ttemp, x, 1) = " " Then
y = x
GoTo A:
End If
Next
A:
T = T & Left(Ttemp, y)
Ttemp = Mid(Ttemp, y + 1, 9999)
If Len(Ttemp) > 60 Then
T = T & vbCrLf
End If
End If
Loop
C.Offset(0, 1) = T '1-tallet bestemmer at den ombrudte tekst står en kolonne til venstre for oprindelige tekst
Next C
End Sub

Rettelse til konmentaren i 4. sidste linie: til højre for oprindelige tekst

Det var præcis det jeg havde brug for, Jens.
Kopierer du ikke lige ind i et svar, så jeg kan give dig nogle point for det.

Mange tak.

Kan du evt justere i koden, så den først "retter teksten ud".
Nogle gange er teksten, der står i cellen allerede halvvejs ombrudt og det tror jeg måske vil få den til at se "fjollet" ud.

Sub LineShift()
Dim C As Range
Dim T As String
Dim Ttemp As String
For Each C In Range("D1:D12").Cells 'her vælges området med oprindelig tekst
Ttemp = C
Ttemp = Replace(C, Chr(10), " ")
Ttemp = Replace(Ttemp, "  ", " ")
T = ""
Do Until Len(Ttemp) = 0
If Len(C) < 60 Then
T = T & Ttemp
Ttemp = ""
Else
For x = 60 To 1 Step -1
If Mid(Ttemp, x, 1) = " " Then
y = x
GoTo A:
End If
Next
A:
T = T & Left(Ttemp, y)
Ttemp = Mid(Ttemp, y + 1, 9999)
If Len(Ttemp) > 60 Then
T = T & vbCrLf
End If
End If
Loop
C.Offset(0, 1) = T '1-tallet bestemmer at den ombrudte tekst står en kolonne til højre for oprindelige tekst
Next C
End Sub