[AccessD] Parsing text

Bryan Carbonnell carbonnb at gmail.com
Thu Sep 15 20:28:08 CDT 2005


On 15/09/05, Francisco Tapia <fhtapia at gmail.com> wrote:
> does anyone have a routine that will do the following:
> 
> SOME TEXT ENTERED HERE
> SOME MORE ENTERED HERE
> AGAIN
> 
> it'd prefer to have the code handle this on the ON CHANGE EVENT the idea is
> to have the text break at the 25th character but if the break is in the
> middle of the word, I will need the break to occur before the word so it
> ends up on the next line as the sample above is shown... i'm posting here in
> case someone has ran into this situation before...

Francisco,

Here is a function that I wrote to limit line length to 80 characters
for a Word template.

You will notice that in the code it limits to 68, that is because of a
line leader that gets inserted. It will also not split text in quotes,
but will move it down to the next line if it can.

It may be a good starting point.

Private Function fMax80(strIn As String, strLeader As String) As String
'--------------------------------------------------------------------------
'.Purpose      : To Keep output Line Lengths to 80 charachters
'.Author       : Bryan Carbonnell
'.Date         : 28-Aug-2002
'.Called by    : sExportToWord
'.Inputs       : strIn - String - Incoming string to Check
'.Output       : fMax80 - String - Return string limit to 80 characters
'.Revised      : 28-Aug-2002 - Original
'--------------------------------------------------------------------------
Const cstrProcName As String = "fMax80"

Dim lngPos As Long
Dim strTemp As String
Dim lngLen As Long
Dim lngLoop As Long
Dim bolInQuote As Boolean

If Len(strIn) > 68 Then
    strTemp = Left$(strIn, 67)
    'Check for quotes
    If InStr(strTemp, """") > 0 Then
        'There is at least one quote so we have to break the line logically
        For lngLoop = 1 To 67
            If Mid(strTemp, lngLoop, 1) = """" Then
                'We have hit a quote mark, so we need to flip bolInQuote
                bolInQuote = Not bolInQuote
            End If
        Next
        'Are we inside a quote
        If bolInQuote = True Then
            'we are inside a quote, so we need to go back to before the quote
            Do While (InStr(lngPos + 1, strTemp, """") > 0)
                'Loop to find the last " mark
                lngPos = InStr(lngPos + 1, strTemp, """")
            Loop
            'Get upto last "
            strTemp = Left$(strTemp, lngPos - 1) & "_" & vbCrLf
            'Add leader and check the remainder is not too large
            strTemp = strTemp & strLeader & fMax80("      " &
Mid$(strIn, lngPos), strLeader)
        Else
            ' We can just break the line at a space
            Do While (InStr(lngPos + 1, strTemp, " ") > 0)
                'loop to find last space
                lngPos = InStr(lngPos + 1, strTemp, " ")
            Loop
            'Get upto last space
            strTemp = Left$(strTemp, lngPos) & "_" & vbCrLf
            'Add leader and check the remainder is not too large
            strTemp = strTemp & strLeader & fMax80("      " &
Right(strIn, Len(strIn) - lngPos), strLeader)
        End If
    Else
        ' We can just break the line at a space
        Do While (InStr(lngPos + 1, strTemp, " ") > 0)
            'loop to find last space
            lngPos = InStr(lngPos + 1, strTemp, " ")
        Loop
        'Get upto last space
        strTemp = Left$(strTemp, lngPos) & "_" & vbCrLf
        'Add leader and check the remainder is not too large
        strTemp = strTemp & strLeader & fMax80("      " & Right(strIn,
Len(strIn) - lngPos), strLeader)
     End If
    fMax80 = strTemp
Else
    'Line less than 80 characters, so nothing needs to be done
    fMax80 = strIn
End If

End Function

It gets called like this:
Debug.print fMax80(strInputText, strLeader)

-- 
Bryan Carbonnell - carbonnb at gmail.com
Life's journey is not to arrive at the grave safely in a well
preserved body, but rather to skid in sideways, totally worn out,
shouting "What a great ride!"



More information about the AccessD mailing list