Inserir quebra de linha após 40 caracteres em um texto dentro de uma célula
Enviado: 29 Dez 2022 às 20:06
Boa noite pessoal, me ajudem em uma situação, tenho alguns textos grandes que preciso inserir uma quebra de linha a cada 40 caracteres manualmente (ALT+ENTER), porem da muito trabalho pois são varias linhas.
encontrei isso, porem esse código insere a quebra quando tiver "/"..... e o que eu preciso que quando chegar ao caracter número 40 quebre a linha.
Private Sub CommandButton1_Click()
Dim w As Worksheet
Dim ultcel As Range
Dim ln As Long
Dim col As Long
Dim novotexto As String
Set w = wsGravação
Set ultcel = w.Cells(w.Rows.Count, 1).End(xlUp)
ln = 2
col = 1
w.Cells(ln, col).Select
w.Range("B2:C" & ultcel.Row).ClearContents
w.Range("B:B").NumberFormat = "@"
Do While ln <= ultcel.Row
novotexto = Replace(w.Cells(ln, col).Value, " / ", Chr(10))
With w.Cells(ln, col + 1)
.WrapText = True
.Value = novotexto
End With
ln = ln + 1
Loop
MsgBox "Processo Concluído"
End Sub
preciso que fique igual ao exemplo do anexo !
valeu galera!
encontrei isso, porem esse código insere a quebra quando tiver "/"..... e o que eu preciso que quando chegar ao caracter número 40 quebre a linha.
Private Sub CommandButton1_Click()
Dim w As Worksheet
Dim ultcel As Range
Dim ln As Long
Dim col As Long
Dim novotexto As String
Set w = wsGravação
Set ultcel = w.Cells(w.Rows.Count, 1).End(xlUp)
ln = 2
col = 1
w.Cells(ln, col).Select
w.Range("B2:C" & ultcel.Row).ClearContents
w.Range("B:B").NumberFormat = "@"
Do While ln <= ultcel.Row
novotexto = Replace(w.Cells(ln, col).Value, " / ", Chr(10))
With w.Cells(ln, col + 1)
.WrapText = True
.Value = novotexto
End With
ln = ln + 1
Loop
MsgBox "Processo Concluído"
End Sub
preciso que fique igual ao exemplo do anexo !
valeu galera!