VBA Tips - Inserindo quebra automática - Insert automatic line breaks

A funcionalidade a seguir teria me poupado muito tempo nas inúmeras vezes que precisei de algo assim. 

Em certas circunstâncias específicas juntamos as informações de inúmeros campos para compor um texto. Ao apresentá-lo, invariavelmente teremos um espaço limitado.

A função abaixo permite que formatemos a frase delimitando onde será realizada a mudança de linha.

Muito útil em highlights de apresentações Powerpoint, quando a composição dos comentários é formada por várias fontes de dados como tabelas e gráficos.

Pode acelerar muito a composição de Dashboards, onde os comentários são seguidos de números e ranges. O texto ficará automaticamente pré-formatado.

Certamente será ainda mais útil na composição de infográficos

Public   Function BreakTextAtX (_

         varOriginal As Variant, _

Optional strBreakCharacter As String = " ", _

Optional lngMaxLength As Long = 72) As Variant

' Code written by Ken Snell -- 15 November 2008

' strOriginal is the original text string

' strBreakCharacter is the character that is used to break the

'       text into separate lines (e.g., a blank space); if no

'       character is provided to the function, it uses a blank

'       space as the value

' lngMaxLength is the maximum length for each separate line;

'       if no length is provided ot the function, it uses 72

'       as the maximum length

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

Let 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 Let 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

Tags: VBA, Tips, Office, quebra, texto, linha, row, linefeed, line break, quebra, página, highlight

Inspiration: 

Download: