This code converts a string to Proper Case (ie the first character of every word to upper case).
Example
Text1.Text = Capitalize(Text1.Text, " .:?!", False, True)
/p>
Add the following code to a form or module.
' strAllText: The text to bee Replaced
' sDelimiter: You can put some characters
' eg. if sDelimiter=
"'./;\=-()"
' the character
after these will be UCase
' blnLineFeed: If True First character
' for evry Line
will be UCase
' blnNoReplace: If True the characters that are
' UCase will not
change
'
Public Function ProperCase(strAllText As String, _
Optional sDelimiter As String = " ", _
Optional blnLineFeed As Boolean = False, _
Optional blnNoReplace As Boolean = False) As String
If Len(strAllText) = 0 Then Exit Function
If Len(strAllText) > 32767 Then
' if Len of th Text is to big You can call this
' Function sometimes with the text
' smoler than 32767 characters
ProperCase = strAllText
Exit Function
End If
Dim lPos As Long, lLenText As Long
Dim I As Integer
Dim strTemp As String, sReturnValue As String
Dim blnCaps As Boolean
On Error GoTo ErrorClear
If InStr(1, sDelimiter, Chr(32), 0) = 0 Then
sDelimiter = sDelimiter & Chr(32)
End If
If blnLineFeed = True Then
'First Character for Evry Line = UCase
If InStr(1, sDelimiter, Chr(10), 0) = 0 Then
sDelimiter = sDelimiter & Chr(10)
End If
End If
If blnNoReplace = True Then
strTemp = strAllText
Else
strTemp = LCase(strAllText)
End If
lLenText = Len(strTemp)
sReturnValue = String(lLenText, " ")
blnCaps = True
If Len(sDelimiter) > 5 Then GoTo SlowCaps
For lPos = 1 To lLenText
For I = 1 To Len(sDelimiter)
If Mid$(strTemp, lPos, 1) = Mid$(sDelimiter, I, 1)
Then
sReturnValue = Mid$(sReturnValue, 1, lPos -
1) & _
Mid$(strTemp, lPos, 1) & _
Mid$(sReturnValue, lPos + 1)
blnCaps = True
GoTo NextCharA
End If
Next I
If blnCaps = True Then
sReturnValue = Mid$(sReturnValue, 1, lPos - 1) & _
UCase(Mid$(strTemp, lPos, 1)) & _
Mid$(sReturnValue, lPos + 1)
blnCaps = False
Else
sReturnValue = Mid$(sReturnValue, 1, lPos - 1) & _
Mid$(strTemp, lPos, 1) & _
Mid$(sReturnValue, lPos + 1)
End If
NextCharA:
Next lPos
GoTo TakeValue
' If Len(sDelimiter) <= 5
SlowCaps:
For lPos = 1 To lLenText
If InStr(1, sDelimiter, Mid$(strTemp, lPos, 1), 0) > 0
Then
sReturnValue = Mid$(sReturnValue, 1, lPos - 1) & _
Mid$(strTemp, lPos, 1) & _
Mid$(sReturnValue, lPos + 1)
blnCaps = True
GoTo NextCharB
End If
If blnCaps = True Then
sReturnValue = Mid$(sReturnValue, 1, lPos - 1) & _
UCase(Mid$(strTemp, lPos, 1)) & _
Mid$(sReturnValue, lPos + 1)
blnCaps = False
Else
sReturnValue = Mid$(sReturnValue, 1, lPos - 1) & _
Mid$(strTemp, lPos, 1) & _
Mid$(sReturnValue, lPos + 1)
End If
NextCharB:
Next lPos
TakeValue:
ProperCase = sReturnValue
Exit Function
ErrorClear:
MsgBox Err.Description & vbCrLf, vbInformation, "ProperCase Function"
Err.Clear
End Function/p>
Comments