thamest
03-22-2007, 07:23 AM
I have a textbox that an operator types in, and I need to format the string according to a max column witdh(55 -60 characters). I tried to tokenize the string, InStr, InStrRev, but I still accasionally get a line that run's over the frames border. Is there anyway to get the string wordwrapped to a max column width of 60 characters?
Here's the code I've written that works best so far:
But still doesn't work everytime.
Public Sub BuildDescrArray()
Dim sTmp, sTmp2 As String
Dim i As Integer, iLen As Integer
If DescCnt = "" Then
msg = MsgBox("There must be at least one line item entered in the Description Column", vbCritical, Missing Information")
Exit Sub
StartForm.Show
End If
ReDim Preserve DescStrArray(0 To DescCnt)
sTmp = Array(Split(StartForm.TextBox3.Text, (vbCrLf & vbCrLf))) '''split first time according to double carriage
For b = 0 To UBound(sTmp(0)) '''returns in the textbox
sTmp2 = Split(sTmp(0)(b), vbCrLf)
For c = 0 To UBound(sTmp2)
If Len(sTmp2(c)) > 54 Then
If Len(sTmp2(c)) > 108 Then
Do
position = InStr((position + 1), sTmp2(c), " ")
spacecnt = spacecnt + 1
Loop Until position = 0
position = InStr(1, sTmp2(c), " ")
Do
If spacecnt = 0 Then
Exit Do
End If
position = InStr((position + 1), sTmp2(c), " ")
If position >= 54 Then
sTmp2(c) = Left(sTmp2(c), position) & vbCr & Right(sTmp2(c), Len(sTmp2(c)) - position)
tmppos = position
tmppos1 = position
Do
If spacecnt = 0 Then
Exit Do
End If
position = InStr((tmppos1 + 1), sTmp2(c), " ")
tmppos1 = position
spacecnt = spacecnt - 1
Loop Until position >= (tmppos + 54) Or position = 0
End If '''position >= 54
spacecnt = spacecnt - 1
Loop Until position = 0
Else
position = InStrRev(sTmp2(c), " ", Len(sTmp2(c)))
Do
position = InStrRev(sTmp2(c), " ", (position - 1))
If position <= 54 Then
sTmp2(c) = Left(sTmp2(c), position) & vbCr & Right(sTmp2(c), Len(sTmp2(c)) - position)
Exit Do
End If '''position <= 54
Loop Until position = 0
End If
Else
DescStrArray(b) = sTmp2(c)
'Exit For
End If
tempstr = tempstr & sTmp2(c) & vbCr
Next c
DescStrArray(b) = Split(tempstr, vbCr) '''split second time according to carriage returns in the lineNext b
tempstr = ""
Next b
End Sub
EDIT: Added VBA Code tags Tommy
Here's the code I've written that works best so far:
But still doesn't work everytime.
Public Sub BuildDescrArray()
Dim sTmp, sTmp2 As String
Dim i As Integer, iLen As Integer
If DescCnt = "" Then
msg = MsgBox("There must be at least one line item entered in the Description Column", vbCritical, Missing Information")
Exit Sub
StartForm.Show
End If
ReDim Preserve DescStrArray(0 To DescCnt)
sTmp = Array(Split(StartForm.TextBox3.Text, (vbCrLf & vbCrLf))) '''split first time according to double carriage
For b = 0 To UBound(sTmp(0)) '''returns in the textbox
sTmp2 = Split(sTmp(0)(b), vbCrLf)
For c = 0 To UBound(sTmp2)
If Len(sTmp2(c)) > 54 Then
If Len(sTmp2(c)) > 108 Then
Do
position = InStr((position + 1), sTmp2(c), " ")
spacecnt = spacecnt + 1
Loop Until position = 0
position = InStr(1, sTmp2(c), " ")
Do
If spacecnt = 0 Then
Exit Do
End If
position = InStr((position + 1), sTmp2(c), " ")
If position >= 54 Then
sTmp2(c) = Left(sTmp2(c), position) & vbCr & Right(sTmp2(c), Len(sTmp2(c)) - position)
tmppos = position
tmppos1 = position
Do
If spacecnt = 0 Then
Exit Do
End If
position = InStr((tmppos1 + 1), sTmp2(c), " ")
tmppos1 = position
spacecnt = spacecnt - 1
Loop Until position >= (tmppos + 54) Or position = 0
End If '''position >= 54
spacecnt = spacecnt - 1
Loop Until position = 0
Else
position = InStrRev(sTmp2(c), " ", Len(sTmp2(c)))
Do
position = InStrRev(sTmp2(c), " ", (position - 1))
If position <= 54 Then
sTmp2(c) = Left(sTmp2(c), position) & vbCr & Right(sTmp2(c), Len(sTmp2(c)) - position)
Exit Do
End If '''position <= 54
Loop Until position = 0
End If
Else
DescStrArray(b) = sTmp2(c)
'Exit For
End If
tempstr = tempstr & sTmp2(c) & vbCr
Next c
DescStrArray(b) = Split(tempstr, vbCr) '''split second time according to carriage returns in the lineNext b
tempstr = ""
Next b
End Sub
EDIT: Added VBA Code tags Tommy