✔ Programação GLOBAL®: 72

Mostrando postagens com marcador 72. Mostrar todas as postagens

VBA Access - Quebra uma Linha a partir de um caracter - BreakTextAtX

Consultancy in Excel, Access, VBA, Dashboards, Scorecards & PowerPoint Projects

DESENVOLVO APLICAÇÕES VBA

Perguntas, Questões e Esclarecimentos

Esta função tem a capacidade de inserir quebras nas linhas, a partir de um carácter identificado.

Function BreakTextAtX (varOriginal As Variant, _

Optional strBreakCharacter As String = " ", _

Optional lngMaxLength As Long = 72) As Variant

Dim strNewString As String, strWorking As String, strPart As String

Dim strOriginalNoCrLf As String

Dim lngPosition As Long, lngHold As Long, lngLength As Long

Dim lngWorkLength As Long

lngLength = Len(varOriginal & "")

If lngLength > 0 Then

Let strOriginalNoCrLf = Replace(Replace(CStr(varOriginal), vbCr, ""), _

vbLf, "")

Let strNewString = ""

Let lngPosition = 1

Do While lngPosition <= lngLength

Let strWorking = Mid(strOriginalNoCrLf, lngPosition, lngMaxLength)

Let lngWorkLength = Len(strWorking)

If lngWorkLength < lngMaxLength Then

If Len(strNewString) > 0 And Len(strWorking) > 0 Then _

Let strNewString = strNewString & vbCrLf

Let strNewString = strNewString & strWorking

Exit Do

Else

Let lngHold = InStrRev(strWorking, strBreakCharacter)

If lngHold = 0 Then lngHold = lngWorkLength

If Len(strNewString) > 0 Then _

Let strNewString = strNewString & vbCrLf

Let strNewString = strNewString & Left(strWorking, lngHold)

Let lngPosition = lngPosition + lngHold

End If

Loop

Let BreakTextAtX = strNewString

Else

If IsNull(varOriginal) = True Then

Let BreakTextAtX = varOriginal

Else

Let BreakTextAtX = ""

End If

End If

End Function