Tekst afkappen naar 40 karakters

[Andre01]

Mijn volgende vraag:

Is het mogelijk om een regel tekst in één cel automatisch in te korten tot 40 karakters?

Als de tekst langer is dan dient deze op de regel daaronder ingevoegd te worden. Dit dient door te gaan tot er geen caracters meer over zijn.


Dus normaal: in één cel 150 karakters moet worden:

in cel één 40 karakters
de cel daaronder 40 karakters
de cel daaronder 40 karakters
de cel daaronder 30 karakters.

Het zou nog mooier zijn als hij de tekst bij een spatie afbrak en niet midden in een woord.

 

[maestro12]

Uhhm, maak de cel zo breed als je wilt, klik met rechts en kies celeigenschappen, tabblad uitlijning en zet een vinkje bij terugloop.

 

[Andre01]

die ken ik

Die had ik ook al,

Maar ik heb een keer gezien dat excel dit ook automatisch kan doen ?

 

[maestro12]

Als jij alle cellen selecteerd, waar dit in zou moeten gebeuren en dan de celeigenschappen kiest, de automatische terugloop aanvinkt, zal excel dit ook automatisch doen.

 

[Jan van Asseldonk]

Met onderstaande code kan dit.
De macro start in de geselecteerde cel, verplaatst het deel na de eerste spatie na het 30e karakter naar de onderliggende cel en herhaalt zichzelf in de onderliggende cel indien de inhoud langer is dan 40 karakters.

Let op, er wordt niet gecontroleerd of onderliggende cellen al iets bevatten.


Sub TekstVerdelen()
'
' TekstVerdelen Macro

Dim txtdeel1, txtdeel2
Dim spatiepos
'
'ActiveCell.Select
While Len(ActiveCell) > 40
spatiepos = InStr(30, ActiveCell, " ", 1)
txtdeel1 = Left(ActiveCell.FormulaR1C1, spatiepos)
txtdeel2 = Mid(ActiveCell.FormulaR1C1, spatiepos, Len(ActiveCell) - Len(txtdeel1))
ActiveCell.FormulaR1C1 = txtdeel1
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = txtdeel2
Wend
ActiveCell.Offset(1, 0).Select

End Sub

 

[Andre01]

invoeren

Bedankt voor het bericht,

Maar het is me niet helemaal duidelijk waar ik deze invoer ?

En is het ook mogelijk om hem te laten kijken of er in de onderstaande cel al tekst aanwezig is? Zodat hij automatisch een nieuwe regel invoegd?


Bedankt alvast,

 

[Jan van Asseldonk]

Code invoegen als volgt.
Open de vba-editor met Alt+F11.
Kies invoegen, module en plak de code in het rechterdeel.

Aangepaste code met controle of er een regel ingevoegd moet worden en dim netjes ingesteld:

Sub TekstVerdelen()
'
' TekstVerdelen Macro

Dim txtdeel1, txtdeel2 As String
Dim spatiepos As Integer
'
'ActiveCell.Select
While Len(ActiveCell) > 40
spatiepos = InStr(30, ActiveCell, " ", 1)
txtdeel1 = Left(ActiveCell.FormulaR1C1, spatiepos)
txtdeel2 = Mid(ActiveCell.FormulaR1C1, spatiepos, Len(ActiveCell) - Len(txtdeel1))
ActiveCell.FormulaR1C1 = txtdeel1
ActiveCell.Offset(1, 0).Select
If ActiveCell.Formula <> "" Then
Rows(ActiveCell.Row).Insert
End If
ActiveCell.FormulaR1C1 = txtdeel2
Wend
ActiveCell.Offset(1, 0).Select
End Sub'

 

[Andre01]

gelukt

Beste Jan,

Ja dat ziet er heel goed uit. Ben er zeer tevreden mee, maar heb nog één vraag.

Ik moet nu per in te korten cel op ALT+F8 drukken om de macro uit te laten voeren.

Kan ik het ook zo maken dat als ik eenmaal op ALT+F8 druk. Dat dan automatisch bijvoorbeeld alle cellen in kolom B beet worden gepakt en in worden gekort ?

Bedankt alvast.

Groeten,

André

 

[Jan van Asseldonk]

Nu loopt ie door in de kolom totdat ie een lege cel tegenkomt.

Sub TekstVerdelen()
'
' TekstVerdelen Macro

Dim txtdeel1, txtdeel2 As String
Dim spatiepos As Integer
'
While Not IsEmpty(ActiveCell)
While Len(ActiveCell) > 40
spatiepos = InStr(30, ActiveCell, " ", 1)
txtdeel1 = Left(ActiveCell.FormulaR1C1, spatiepos)
txtdeel2 = Mid(ActiveCell.FormulaR1C1, spatiepos, Len(ActiveCell) - Len(txtdeel1))
ActiveCell.FormulaR1C1 = txtdeel1
ActiveCell.Offset(1, 0).Select
If ActiveCell.Formula <> "" Then
Rows(ActiveCell.Row).Insert
End If
ActiveCell.FormulaR1C1 = txtdeel2
Wend
ActiveCell.Offset(1, 0).Select
Wend
End Sub

 

[Jan van Asseldonk]

Aanvulling:
Als je alleen maar een cel in wil voegen i.p.v. een volledige rij vervang dan
Rows(ActiveCell.Row).Insert
door
Selection.Insert Shift:=xlDown

 

[Andre01]

Jan,

Mag ik je vriendelijk bedanken. het werkt als een trein.
Alleen stopt hij af en toe omdat hij hem niet af kan kappen. ik denk dat hij dan geen spatie ziet.

Maar dat maakt me niet zoveel uit. Dat verander ik dan even handmatig

Ik doe nu 3 uur werk in 10 minuten!

Enorm bedankt,

André