Public Function LoadWrapList(lst As Access.listbox, longString As Variant, Optional PK As Variant = 0, Optional wholeWords = True) As String
Dim visWidth As Long
Dim visWidthInches As Long
Dim arr() As String
Dim I As Integer
Dim txt As String
Dim txtLength As Long
Const buffer = 40
'I think this makes sense only with one visible column little more complicated if not
lst.RowSourceType = "Value List"
visWidth = lst.Width - buffer
lst.ColumnCount = 2
lst.ColumnWidths = "0;" & visWidth / 1440 & " in"
ClearList lst
If Not IsNull(longString) Then
longString = Replace(longString, ",", "")
If wholeWords Then
arr = Split(longString, " ")
For I = 0 To UBound(arr)
If txt = "" Then
txt = txt & Trim(arr(I))
Else
txt = txt & " " & Trim(arr(I))
End If
txtLength = GetTextLength(lst, txt)
If GetTextLength(lst, arr(I)) > visWidth Then
MsgBox "Whole words are greater than visible length. Exiting", vbInformation
Exit Function
End If
If txtLength >= visWidth Or arr(I) = vbCrLf Then
If txtLength > visWidth Or arr(I) = vbCrLf Then
' roll back
txt = Left(txt, Len(txt) - Len(arr(I)))
If I > 0 Then I = I - 1
End If
'Debug.Print PK & "; " & txt
lst.AddItem PK & "; " & Trim(txt)
txt = ""
End If
Next I
If txt <> "" Then lst.AddItem PK & "; " & Trim(txt)
Else
For I = 1 To Len(longString)
txt = txt & Mid(longString, I, 1)
'Debug.Print txt
txtLength = GetTextLength(lst, txt)
If txtLength >= visWidth Then
If txtLength > visWidth Then
' roll back
txt = Left(txt, Len(txt) - 1)
I = I - 1
End If
'Debug.Print PK & "; " & txt
lst.AddItem PK & "; " & txt
txt = ""
End If
Next I
End If
End If
End Function
Public Function GetTextLength(pCtrl As Control, ByVal str As String, _
Optional ByVal Height As Boolean = False)
Dim lx As Long, ly As Long
' Initialize WizHook
WizHook.Key = 51488399
' Populate the variables lx and ly with the width and height of the
' string in twips, according to the font settings of the control
WizHook.TwipsFromFont pCtrl.FontName, pCtrl.FontSize, pCtrl.FontWeight, _
pCtrl.FontItalic, pCtrl.FontUnderline, 0, _
str, 0, lx, ly
If Not Height Then
GetTextLength = Abs(lx)
Else
GetTextLength = Abs(ly)
End If
End Function
Public Sub ClearList(lst As Access.listbox)
Dim I As Integer
If lst.RowSourceType = "value list" Then
For I = lst.ListCount - 1 To 0 Step -1
lst.RemoveItem (I)
Next I
Else
lst.RowSource = ""
End If
End Sub
