VBA Snippets


Char_Capital

Ensures that a single character is in uppercase.
Public Function Str_CharCapital(
ByVal sChar As String) _
As String

Const sPROCNAME As String = "Str_CharCapital"
On Error GoTo ErrorHandler

If (Asc(sChar) >= 97) And (Asc(sChar) <= 122) Then
Str_CharCapital = Chr(Asc(sChar) - 32)
Else
Str_CharCapital = sChar
End If

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"make sure the character """ & sChar & """ is in uppercase")
End Function

Char_FindPositionofNext

Returns the character position of a particular character in a string.
Public Function Str_CharFindPositionofNext( _
ByVal sText As String, _
ByVal sChar As String, _
Optional ByVal iOccuranceNo As Integer = 1) _
As Integer

Const sPROCNAME As String = "Str_CharFindPositionofNext"
Dim iposition As Integer
Dim soriginal As String
On Error GoTo ErrorHandler

iposition = 0
soriginal = sText
Do While (iOccuranceNo > 0) And (iposition <> -1)
iposition = InStr(1, sText, sChar)
If iposition = 0 Then
Str_CharFindPositionofNext = -1
End If
If iposition = 0 Then
Exit Function
End If
sText = Right(sText, Len(sText) - iposition)
iOccuranceNo = iOccuranceNo - 1
Loop
Str_CharFindPositionofNext = Len(soriginal) - Len(sText)

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the characater position of the " & iOccuranceNo & _
" occurrence of the character """ & sChar & """")
End Function

Char_IsIt

Determines if a character is a valid letter, either lowercase or uppercase. Returns True or False.
Public Function Str_CharIsIt( _
ByVal sChar As String) _
As Boolean

Const sPROCNAME As String = "Str_CharIsIt"
On Error GoTo ErrorHandler

If Len(sChar) = 0 Then
Str_CharIsIt = False
End If
If Len(sChar) = 0 Then
Exit Function
End If
If ((Asc(sChar) >= 65 And Asc(sChar) <= 90)) Or _
((Asc(sChar) >= 97 And Asc(sChar) <= 122)) Then
Str_CharIsIt = True
Else
Str_CharIsIt = False
End If

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"determine if the character """ & sChar & """" & _
"is a valid character")
End Function

Char_IsNumber

Determines if a character is a valid number, either a single digit or multiple digits. Returns True or False.
Public Function Str_CharIsNumber( _
ByVal sChar As String) _
As Boolean

Const sPROCNAME As String = "Str_CharIsNumber"
On Error GoTo ErrorHandler

If (IsNumeric(sChar) = True) Then
Str_CharIsNumber = True
End If
If (IsNumeric(sChar) = False) Then
Str_CharIsNumber = False
End If

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"determine if the character """ & sChar & """" & _
"is a valid number")
End Function

Char_No

Public Function Str_CharNo( _
ByVal sText As String, _
ByVal iCharNo As Integer) _
As String

Const sPROCNAME As String = "Str_CharNo"
Dim shalfway As String
On Error GoTo ErrorHandler

If iCharNo > 0 Then
shalfway = Left(sText, iCharNo) 'remove the LHS
Str_CharNo = Right(shalfway, 1) 'remove the RHS
Else
Str_CharNo = ""
End If

If gbDEBUG_ERRMSG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return character " & iCharNo & " from the string '" & sText & "'.")
End Function

Char_NoOf

Returns the total number of occurrences of a particular character in a string.
Public Function Str_CharNoOf( _
ByVal sText As String, _
ByVal sChar As String) _
As Integer

Const sPROCNAME As String = "Str_CharNoOf"
Dim inoofCR AsInteger
Dim inextCRno As Integer
On Error Resume Next

inoofCR = 0
Do Until (sText = "")
inextCRno = InStr(1, sText, sChar)
If (inextCRno = 0) Then
sText = ""
Else
sText = Right(sText, Len(sText) - inextCRno)
inoofCR = inoofCR + 1
End If
Loop
Str_CharsNoOf = inoofCR

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the total number of times the character """ & sChar & """" & _
"appears in the text" & vbCrLf & """" & sText & """")
End Function

Public Function Str_CharNoOf2(ByVal sText As String, _
sChar As String) As Integer
Dim icountCR As Integer
Dim icharCR As Integer
On Error GoTo AnError
icountCR = 0

Do While InStr(1, sText, sChar) > 0
icharCR = InStr(1, sText, sChar)
icountCR -icountCR + 1
sText = Right(sText, Len(sText) - icharCR - 1)
Loop

Str_CharNoOf2 = icountCR

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_CharNoOf2", msMODULENAME, 1, _
"return the total number of times the character """ & sChar & """" & _
"appears in the text" & vbCrLf & """" & sText & """")
End Function

Char_Replace

Finds and replaces a character with another character in a string, returning the modified string.
Public Function Str_CharReplace( _
ByVal sText As String, _
ByVal sFindChar As String, _
ByVal sReplaceChar As String) _
As String

Const sPROCNAME As String = "Str_CharReplace"
Dim sfinaltext As String
Dim icount As Integer
On Error GoTo ErrorHandler

For icount = 1 To Len(sText)
If Mid(sText, icount, 1) = sFindChar Then
sfinaltext = sfinaltext & sReplaceChar
Else
sfinaltext = sfinaltext & Mid(sText, icount, 1)
End If
Next icount
Str_CharReplace = sfinaltext

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description,, _
"find the char """ & sFindChar & """ and replace it with the characater " & _
"""" & sReplaceChar & """ in the string" & vbCrLf & """" & sText & """")
End Function

Char_SizeArialNarrow8Bold

Returns the width of an individual character in the font style Arial Narrow, 8, Bold.
Public Function Str_CharSizeArialNarrow8Bold( _
ByVal sChar As String, _
Optional ByVal sngTextBoxWidth As Single = 0) _
As Single

Const sPROCNAME As String = "Str_CharSizeArialNarrow8Bold"
Dim icharwidth As Integer
On Error GoTo AnError

Select Case sChar

End Select
' Char_ArialNarrow8Bold = ??? / icharwidth

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the width of the char """ & sChar & """ in Arial Narrow, 8, Bold")
End Function

Char_SizeArialNarrow8Reg

Returns the width of an individual character in the font style Arial Narrow, 8, Regular.
Public Function Str_CharSizeArialNarrow8Reg( _
ByVal sChar As String, _
Optional ByVal sngTextBoxWidth As Single = 0) _
As Single

Const sPROCNAME As String = "Str_CharSizeArialNarrow8Reg"
Dim icharwidth As Integer
On Error GoTo ErrorHandler

Select Case sChar

End Select
' Char_ArialNarrow8Reg = ??? / icharwidth

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the width of the char """ & sChar & """ in Arial Narrow, 8, Reg")
End Function

Char_SizeArialNarrow9Bold

Returns the width of an individual character in the font style Arial Narrow, 9, Bold.
Public Function Str_CharSizeArialNarrow9Bold( _
ByVal sChar As String, _
Optional ByVal sngTextBoxWidth As Single = 0) _
As Single

Const sPROCNAME As String = "Str_CharSizeArialNarrow9Bold"
Dim icharwidth As Integer
On Error GoTo ErrorHandler

Select Case sChar

End Select
' Char_ArialNarrow9Bold = ??? / icharwidth

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the width of the char """ & sChar & """ in Arial Narrow, 9, Bold")
End Function

Char_SizeArialNarrow9Reg

Returns the width of an individual character in the font style Arial Narrow, 9 Regular.
Public Function Str_CharSizeArialNarrow9Reg( _
ByVal sChar As String, _
Optional ByVal sngTextBoxWidth As Single = 0) _
As Single

Const sPROCNAME As String = "Str_CharSizeArialNarrow9Reg"
Dim icharwidth As Integer
On Error GoTo ErrorHandler

Select Case sChar
Case "a", "b", "d", "e", "g", "h", "n", "o", "p", "q", "u": icharwidth = 170 '191
Case "c", "k", "s", "v", "x", "y", "z": icharwidth = 195 '212
Case "f", "t": icharwidth = 360 '382
Case "i", "j", "l": icharwidth = 450 '478
Case "m": icharwidth = 128
Case "r": icharwidth = 315 ' 319
Case "w": icharwidth = 147
Case "A", "B", "E", "K", "P", "S", "V", "X", "Y": icharwidth = 140 '159
Case "C", "D", "H", "N", "R", "U": icharwidth = 135 '147
Case "F", "T", "Z": icharwidth = 174
Case "G", "O", "Q": icharwidth = 137
Case "I": icharwidth = 382
Case "J": icharwidth = 212
Case "L": icharwidth = 191
Case "M": icharwidth = 128
Case "W": icharwidth = 113
Case "Z": icharwidth = 174
Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0": icharwidth = 170 '191
Case "%": icharwidth = 120
Case "&": icharwidth = 159
Case ".": icharwidth = 368 '382
Case """": icharwidth = 312
Case ",": icharwidth = 382
Case "\": icharwidth = 319
Case "/": icharwidth = 319
Case "-": icharwidth = 320
Case "+": icharwidth = 182
Case " ": icharwidth = 350 '382
Case "": icharwidth = 191
Case Else: icharwidth = 140
End Select
Char_ArialNarrow9Reg = 781 / icharwidth '761

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the width of the char """ & sChar & """ in Arial Narrow, 9, Reg")
End Function

Char_SizeSabon10Bold

Returns the width of an individual character in the font style Sabon, 10, Bold.
Public Function Char_SizeSabon10Bold( _
ByVal sChar As String, _
Optional ByVal sngTextBoxWidth As Single = 0) _
As Single

Const sPROCNAME As String = "Char_SizeSabon10Bold"
Dim icharwidth As Integer
On Error GoTo ErrorHandler

Select Case sChar
Case "a", "b", "d", "e", "g", "o", "p", "q", "v", "x", "y": icharwidth = 54
Case "c", "r", "s", "z": icharwidth = 64
Case "f", "t": icharwidth = 76
Case "h", "n", "u": icharwidth = 48
Case "i", "j", "l", " ": icharwidth = 96
Case "k", "w": icharwidth = 42
Case "m": icharwidth = 32
Case "A": icharwidth = 28
Case "B", "L", "N", "U": icharwidth = 42
Case "C", "D", "H", "K", "R", "V", "X", "Y": icharwidth = 38
Case "E", "F", "G", "P", "S", "T", "Z": icharwidth = 48
Case "I": icharwidth = 64
Case "J": icharwidth = 54
Case "M": icharwidth = 32
Case "O", "Q": icharwidth = 34
Case "W": icharwidth = 27
Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0": icharwidth = 54
Case "%": icharwidth = 25
Case "&": icharwidth = 32
Case "*", "$": icharwidth = 54
Case "-", "(", ")", ":": icharwidth = 76
Case """": icharwidth = 48
Case ",", ".": icharwidth = 86
Case Else: icharwidth = 65
End Select
Char_Sabon10Bold = 288 / icharwidth

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the width of the char """ & sChar & """ in Sabon, 10, Bold")
End Function

Char_SizeSabon10Reg

Returns the width of an individual character in the font style Sabon, 10, Regular.
Public Function Str_CharSizeSabon10Reg( _
ByVal sChar As String, _
Optional ByVal sngTextBoxWidth As Single = 0) _
As Single

Const sPROCNAME As String = "Str_CharSizeSabon10Reg"
Dim icharwidth As Integer
On Error GoTo ErrorHandler

Select Case sChar
Case "a", "e", "s", "z": icharwidth = 64
Case "b", "c", "d", "g", "h", "k", "n", "o", "p", "q", "u", "v", _
"x", "y": icharwidth = 54
Case "f", "r": icharwidth = 76
Case "i", "j", "l": icharwidth = 128
Case "m": icharwidth = 38
Case "t", " ": icharwidth = 96
Case "w": icharwidth = 36
Case "A", "C", "H", "K", "R", "T", "U", "V", "Y": icharwidth = 42
Case "B", "E", "F", "G", "L", "P", "S", "Z": icharwidth = 48
Case "D", "N", "O", "Q", "X": icharwidth = 38
Case "I": icharwidth = 76
Case "J": icharwidth = 64
Case "M", "%": icharwidth = 32
Case "W": icharwidth = 29
Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0": icharwidth = 54
Case "&": icharwidth = 34
Case "*", "$": icharwidth = 54
Case "-", "(", ")", """": icharwidth = 76
Case ",", ".": icharwidth = 86
Case ":": icharwidth = 118
Case Else: icharwidth = 65
End Select
Char_Sabon10Reg = 288 / icharwidth

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the width of the char """ & sChar & """ in Sabon, 10, Reg")
End Function

Char_SizeTahoma8Reg

Returns the width of an individual character in the font style Tahamo, 9, Regular.
Public Function Str_CharSizeTahoma8Reg( _
ByVal sChar As String, _
Optional ByVal sngTextBoxWidth As Single = 0) _
As Single

Const sPROCNAME As String = "Str_CharSizeTahoma8Reg"
Dim icharwidth As Integer
On Error GoTo ErrorHandler

Select Case sChar
Case "a": icharwidth = 118
Case "b", "d", "g", "p", "q", "h", "n", "u", "E", "P", "S", "Z": icharwidth = 113
Case "c": icharwidth = 134
Case "e": icharwidth = 117
Case "f": icharwidth = 194
Case "i", "l": icharwidth = 269
Case "j": icharwidth = 219
Case "k", "v", "x", "y", "L": icharwidth = 124
Case "m": icharwidth = 74
Case "o": icharwidth = 114
Case "r": icharwidth = 171
Case "s", "z": icharwidth = 138
Case "t": icharwidth = 184
Case "w": icharwidth = 80
Case "A", "C", "V": icharwidth = 103
Case "B", "K", "T", "X", "Y": icharwidth = 105
Case "D", "G", "H", "N", "U": icharwidth = 92
Case "F": icharwidth = 118
Case "I": icharwidth = 165
Case "J": icharwidth = 148
Case "M": icharwidth = 80
Case "O", "Q": icharwidth = 87
Case "R": icharwidth = 100
Case "W": icharwidth = 100 'check this \\
Case " ": icharwidth = 198
Case Else: icharwidth = 140
End Select
Char_Tahoma8Reg = 493 / icharwidth

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the width of the char """ & sChar & """ in Tahamo, 8, Reg")
End Function

Char_SizeUniversLight8Reg

Returns the width of an individual character in the font style UniversLight, 8, Regular.
Public Function Str_CharSizeUniversLight8Reg( _
ByVal sChar As String, _
Optional ByVal sngTextBoxWidth As Single = 0) _
As Single

Const sPROCNAME As String = "Str_CharSizeUniversLight8Reg"
Dim inoofchars As Integer
On Error GoTo ErrorHandler

inoofchars = 65 'incase not recognised, use width 65
Select Case sChar
Case "a", "c", "k", "s", "x", "y": inoofchars = 180 '196
Case "b", "d", "e", "g", "h", "n", "o", "p", "q", "u", "v": inoofchars = 160 '176
Case "f", "r": inoofchars = 294
Case "i", "j", "l": inoofchars = 440
Case "m": inoofchars = 110
Case "t", inoofchars = 293
Case "w": inoofchars = 118
Case "z": inoofchars = 220

Case "A", "B", "C", "R": inoofchars = 135 '147
Case "D", "G", "H", "N", "U": inoofchars = 125 '136
Case "E", "K", "P", "S", "V", "X", "Y": inoofchars = 150 '160
Case "F", "L", "T", "Z": inoofchars = 176
Case "I": inoofchars = 352
Case "J": inoofchars = 196
Case "M", inoofchars = 104
Case "O", "Q": inoofchars = 126
Case "W": inoofchars = 98

Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0": inoofchars = 160 '176

Case "%": inoofchars = 98
Case "&": inoofchars = 136
Case "(", ")", "\", "/", ".", ",", """": inoofchars = 310 '352
Case "+": inoofchars = 149
Case "-": inoofchars = 353
Case ".": inoofchars = 352

Case " ": inoofchars = 200
Case Else: inoofchars = 100
End Select
Char_UniversLight8Reg = 785 / inoofchars

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the width of the char """ & sChar & """ in UniversLight, 8, Reg")
End Function

Chars_1013

Determines if a string contains either the character (10 = line feed) or the character (13 = carriage return) What is character (7) ????.
Public Function Str_Chars1013( _
ByVal sText As String) _
As Boolean

Const sPROCNAME As String = "Str_Chars1013"
On Error GoTo ErrorHandler

Do While sText <> ""
'make a full / proper list of characaters 1 to 20 !!!!!!!!!!!!!!!!!!

If (Not Left(sText, 1) = Chr(13)) _
And (Not Left(sText, 1) = Chr(10)) Then 'check the leftmost chars
Str_Chars1013 = False
Exit Function
End If
sText = Right(sText, Len(sText) - 1) 'remove the leftmost char
Loop
Str_Chars1013 = True

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"determine if the string """ & sText & """ consists of just Chars (10) & (13)")
End Function

Chars_1013HasAny

Determines if a string contains either the character (10) or the character (7). Returns True or False.
Public Function Str_Chars1013HasAny( _
ByVal sText As String) _
As Boolean

Const sPROCNAME As String = "Str_Chars1013HasAny"
Dim scurrenttext As String
On Error GoTo ErrorHandler

Str_Chars1013HasAny = False
If sText = Chr(13) & Chr(7) Then
Exit Function
End If
If (Right(sText, 2) = Chr(13) & Chr(7)) Then
sText = Left(sText, Len(sText) - 2)
End If
Do While sText <> ""
If (Right(sText, 1) = Chr(13)) Or (Right(sText, 1) = Chr(7)) Then
Str_Chars1013HasAny = True
Exit Function
End If
sText = Left(sText, Len(sText) - 1)
Loop

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"determine if the string """ & sText & """ has any Chars (13) or (10) in it")
End Function

Chars_1013Remove

Removes all the occurences of the characters (10) or (7), returning the modified string.
Public Function Str_Chars1013Remove( _
ByVal sText As String) _
As String

Const sPROCNAME As String = "Str_Chars1013Remove"
Dim sfinaltext As String
Dim scurrenttext As String
On Error GoTo ErrorHandler

Do While Len(sText) > 0
If (Not Right(sText, 1) = Chr(13)) And _
(Not Right(sText, 1) = Chr(7)) Then _
sfinaltext = Right(sText, 1) & sfinaltext

sText = Left(sText, Len(sText) - 1)
Loop
Str_Chars1013Remove = sfinaltext

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"remove all the occurences of the chars (10) or (7) from the string " & _
vbCrLf & """" & sText & """")
End Function

Chars_Delete

Removes all the characters that are provided as an array from a string.
Public Function Str_CharsDelete( _
ByVal sText As String, _
ParamArray vRemoveChars() As Variant) _
As String

Const sPROCNAME As String = "Str_CharsDelete"
Dim iposition As Integer
Dim stexttemp As String
Dim stextleft As String
Dim stextfinal As String
Dim vchar As Variant
On Error GoTo ErrorHandler

stexttemp = sText
For Each vchar In vRemoveChars()
stextfinal = ""
Do Until (stexttemp = "")
If (Left(stexttemp, 1) <> vchar) Then
stextfinal = stextfinal & Left(stexttemp, 1)
End If
stexttemp = Right(stexttemp, Len(stexttemp) - 1)
Loop
stexttemp = stextfinal
Next vchar
Str_CharsRemove = stextfinal

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"remove the chars """ & ">>>>>>" & """ from the string" & vbCrLf & sText)
End Function

Chars_FindPositionofNext

Returns the position of the first occurrence of any of the characters in an array from a string. If there are no occurrences then -1 is returned.
Public Function Chars_FindPositionofNext( _
ByVal sText As String, _
ParamArray vChars() As Variant) _
As Integer

Const sPROCNAME As String = "Chars_FindPositionofNext"
Dim iposition As Integer
Dim stextleft As String
Dim vchar As Variant
On Error GoTo ErrorHandler

iposition = 1
stextleft = sText
Do Until Len(stextleft) = 0
For Each vchar In vChars()
If Left(stextleft, 1) = vchar Then
Str_CharFindPositionofNext = iposition
Exit Function
End If
Next
iposition = iposition + 1
stextleft = Right(stextleft, Len(stextleft) - 1)
Loop
Chars_FindPositionofNext = -1

If gbDEBUG_ERRMSG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the position of the first occurrence of any of the given characters " & _
"in the string '" & sText & "'")
End Function

Chars_Replace

Replaces all the characters in an array with a different character in a text string.
Public Function Chars_Replace( _
ByVal sText As String, _
ByVal sWithChar As String, _
ParamArray vReplaceChars() As Variant) _
As String

Const sPROCNAME As String = "Chars_Replace"
Dim stextleft As String
Dim stextreturn As String
Dim iposition As Integer
Dim vchar As Variant
On Error GoTo ErrorHandler

stextleft = sText
Do Until Len(stextleft) = 0
For Each vchar In vReplaceChars()
If (Left(stextleft, 1) = vchar) Then
stextreturn = stextreturn & sWithChar
Else
stextreturn = stextreturn & Left(stextleft, 1)
End If
Next vchar
iposition = iposition + 1
stextleft = Right(stextleft, Len(stextleft) - 1)
Loop
Chars_Replace = stextreturn

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"replace all the characters """ & vReplaceChars & _
" with the character """ & sWithChar & """ in the string """ & sText & """")
End Function

Chars_ReturnASCII

Public Function Str_CharsReturnASCII( _
ByVal sCharacters As String) _
As String

Const sPROCNAME As String = "Str_CharsReturnASCII"
Dim itotal As Integer
Dim icharcount As Integer
Dim sreturncode As String
On Error GoTo ErrorHandler

sreturncode = ""
itotal = Len(sCharacters)
For icharcount = 1 To itotal
sreturncode = sreturncode & Asc(Left(sCharacters, 1))
sCharacters = Right(sCharacters, Len(sCharacters) - 1)
Next icharcount
CharsReturnASCII = sreturncode
Exit Function

ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Function

Str_AddUnique

Determine if a string already exists in a string concatenation and adds an entry if it doesn't already exist.
Public Function Str_AddUnique( _
ByVal sText As String, _
ByVal sTextConcat As String, _
Optional sSeperateChar As String = ";") As String

Const sPROCNAME As String = "Str_AddUnique"
Dim scurrenttext As String
Dim stextleft As String
On Error GoTo ErrorHandler

stextleft = sTextConcat
scurrenttext = Str_NextGet(stextleft)
If (scurrenttext = "") Then
Str_AddUnique = sText & sSeperateChar
Exit Function
End If
Do While (scurrenttext <> "")
If scurrenttext = sText Then
Str_AddUnique = sTextConcat
Exit Function
Else
stextleft = Str_NextRemove(stextleft)
scurrenttext = Str_NextGet(stextleft)
End If
Loop
Str_AddUnique = sTextConcat & sText & sSeperateChar

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"determine if the string """ & sText & """ exists already " & _
"in the concatenation" & vbCrLf & sTextConcat & vbCrLf & "and add it if not")
End Function

Str_CapitalFirstLetter

Returns a string ensuring that the first character is a capital letter and the remaining characters are all lowercase.
Public Function Str_CapitalFirstLetter( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_CapitalFirstLetter"
Dim sfinaltext As String
Dim snextchar As String
Dim icount As Integer
Dim bexceptionchar As Boolean
On Error GoTo ErrorHandler

bexceptionchar = True
' find the first char thats a letter and make it a capital

For icount = 1 To Len(sText)
' replace this will a LEFT and RIGHT
snextchar = Str_LeftOf(sText, Len(sText) - 1)
' for everything else leave unless it is a capital letter
If (bexceptionchar = False) And _
(Asc(snextchar) >= 65) And (Asc(snextchar) <= 90) Then
sfinaltext = sfinaltext & Chr(Asc(snextchar) + 32)
Else
sfinaltext = sfinaltext & snextchar
End If
bexceptionchar = False
' If (snextchar = " ") Or _
' (snextchar = "(") Or _
' (snextchar = "-") Or _
' (snextchar = ".") Or _
' (snextchar = """") Then bexceptionchar = True
sText = Right(sText, Len(sText) - 1)
Next icount
Str_CapitalFirstLetter = sfinaltext

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the string """ & sText & """ ensuring that the first letter is a capital")
End Function

Str_Capitals

Returns a string ensuring that all the characters are in uppercase.
Public Function Str_Capitals( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_Capitals"
Dim sfinaltext As String
Dim snextchar As String
Dim icount As Integer
On Error GoTo ErrorHandler

For icount = 1 To Len(sText)
' replace this will a LEFT and RIGHT
snextchar = Str_LeftOf(sText, Len(sText) - 1)
If (Asc(snextchar) >= 65) And (Asc(snextchar) <= 90) Then
sfinaltext = sfinaltext & Chr(Asc(snextchar) + 32)
Else
sfinaltext = sfinaltext & snextchar
End If
sText = Right(sText, Len(sText) - 1)
Next icount
Str_Capitals = sfinaltext

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the string """ & sText & """" & _
"ensuring that the first letter is a capital")
End Function

Str_CharsNoOf

Public Function Str_CharsNoOf( _
ByVal sText As String, _
ByVal sChar As String) As Integer

Const sPROCNAME As String = "Str_CharsNoOf"
Dim inoofCR As Integer
Dim inextCRno As Integer
On Error GoTo ErrorHandler

inoofCR = 0
Do Until (sText = "")
inextCRno = InStr(1, sText, sChar)
If (inextCRno = 0) Then
sText = ""
Else
sText = Right$(sText, Len(sText) - inextCRno)
inoofCR = inoofCR + 1
End If
Loop
Str_CharsNoOf = inoofCR
Exit Function

ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Function
'***********************************************************
Public Function Str_CharsNoOf(ByVal sText As String, _
ByVal sSeparateChar As String) As Integer
Dim icount As Integer
Dim ichar As Integer
On Error GoTo AnError
icount = 0
Do While (InStr(1, sText, sSeparateChar) > 0)
ichar = InStr(1, sText, sSeparateChar)
icount = icount + 1
sText = Right(sText, Len(sText) - ichar - 1)
Loop
Str_CharsNoOf = icount
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_CharsNoOf", msMODULENAME, _
"find the number of occurrences of the character '" & sSeparateChar & "'")
End Function

Str_ConCatAfter

Public Function Str_ConCatAfter( _
ByVal sText As String, _
ByVal sFindText As String, _
Optional ByVal bInformUser As Boolean = True, _
Optional ByVal sSeperateChar As String = ";") As String

Const sPROCNAME As String = "Str_ConCatAfter"
Dim iseperatepos As Integer
Dim serrortext As String
Dim scurrent As String
Dim snext As String
Dim bfound As Boolean
On Error GoTo AnError

serrortext = sText
bfound = False
Do While Len(sText) > 0
iseperatepos = InStr(1, sText, sSeperateChar)
If InStr(1, sText, sSeperateChar) > 0 Then
snext = Left(sText, iseperatepos - 1)
sText = Right(sText, Len(sText) - iseperatepos)
Else
snext = sText
sText = ""
End If
If scurrent = sFindText Then
bfound = True
Str_ConCatAfter = snext
Exit Do
End If
scurrent = snext
Loop
If snext = sFindText Then
bfound = True
Str_ConCatAfter = ""
End If
If bfound = False And bInformUser = True Then GoTo AnError

If gbDEBUG = False Then Exit Function
AnError:
Str_ConCatAfter = ""
Call Error_Handle("Str_ConCatAfter", msMODULENAME, 1, _
"find the string """ & sFindText & """ in the following:" & _
vbCrLf & """" & serrortext & """")
End Function

Str_ConCatBefore

Public Function Str_ConCatBefore( _
ByVal sText As String, _
ByVal sFindText As String, _
Optional bInformUser As Boolean = True, _
Optional sSeperateChar As String = ";") As String

Const sPROCNAME As String = "Str_ConCatBefore"
Dim iseperatepos As Integer
Dim serrortext As String
Dim scurrent As String
Dim sprevious As String
Dim bfound As Boolean
On Error GoTo AnError

serrortext = sText
bfound = False
Do While Len(sText) > 0
iseperatepos = InStr(1, sText, sSeperateChar)
If InStr(1, sText, sSeperateChar) > 0 Then
scurrent = Left(sText, iseperatepos - 1)
sText = Right(sText, Len(sText) - iseperatepos)
Else
scurrent = sText
sText = ""
End If
If scurrent = sFindText Then
bfound = True
Str_ConCatBefore = sprevious
Exit Do
End If
sprevious = scurrent
Loop
If bfound = False And bInformUser = True Then GoTo AnError

If gbDEBUG = False Then Exit Function
AnError:
Str_ConCatBefore = ""
Call Error_Handle("Str_ConCatBefore", msMODULENAME, 1, _
"find the string """ & sFindText & """ in the following:" & _
vbCrLf & """" & serrortext & """")
End Function

Str_ConCatExists

Determines if a text string already exists in a concatenation of text strings. Returns True of False.
Public Function Str_ConCatExists( _
ByVal sText As String, _
ByVal sTextConcat As String, _
Optional sSeperateChar As String = ";", _
Optional bIgnoreBrackets As Boolean = False) As Boolean

Const sPROCNAME As String = "Str_ConCatExists"
Dim scurrenttext As String
Dim iopenbracketpos As Integer
Dim larraycount As Long
On Error GoTo AnError

scurrenttext = Str_NextGet(sTextConcat)
Do While scurrenttext <> ""
If bIgnoreBrackets = True Then
iopenbracketpos = InStr(1, scurrenttext, "(")
scurrenttext = Left(scurrenttext, iopenbracketpos - 1)
End If
If scurrenttext = sText Then
Str_ExistsStrConCat = True
Exit Function
Else
sTextConcat = Str_NextRemove(sTextConcat)
scurrenttext = Str_NextGet(sTextConcat)
End If
Loop
Str_ConCatExists = False

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_ConCatExists", msMODULENAME, 1, _
"determine if the string """ & sText & """ exists already " & _
"in the concatenation" & vbCrLf & """" & sTextConcat & """")
End Function

Str_ConCatFrom

Public Function Str_ConCatFrom( _
ByVal sAddress As String, _
ByVal sCharInsert As String, _
Optional sCharSeperate As String = "#") As String

Const sPROCNAME As String = "Str_ConCatFrom"
Dim icharCR As Integer
Dim snewaddress As String
On Error GoTo AnError

snewaddress = ""
Do While InStr(1, sAddress, sCharSeperate) > 0
icharCR = InStr(1, sAddress, sCharSeperate)
snewaddress = snewaddress & Left(sAddress, icharCR - 1) & sCharInsert
sAddress = Right(sAddress, Len(sAddress) - icharCR + 1 - Len(sCharSeperate))
Loop
snewaddress = snewaddress & sAddress
Str_ConCatFrom = snewaddress

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_ConCatFrom", msMODULENAME, 1, _
"expand the address from a single line")
End Function

Str_ConCatRemove

Public Function Str_ConCatRemove( _
ByVal sText As String, _
ByVal sRemoveText As String, _
Optional sSeparateChar As String = ";") As String

Dim iseparatepos As Integer
Dim serrortext As String
Dim scurrent As String
Dim snewtext As String
On Error GoTo AnError

serrortext = sText
Do While Len(sText) > 0
iseparatepos = InStr(1, sText, sSeparateChar)
If InStr(1, sText, sSeparateChar) > 0 Then
scurrent = Left(sText, iseparatepos - 1)
sText = Right(sText, Len(sText) - iseparatepos)
Else
scurrent = sText
sText = ""
End If
If InStr(1, sRemoveText, scurrent) = 0 Then 'ie not in the list then add
snewtext = snewtext & scurrent & sSeparateChar
End If
Loop
Str_ConCatRemove = Left(snewtext, Len(snewtext) - 1)

If gbDEBUG = False Then Exit Function
AnError:
Str_ConCatRemove = serrortext
Call Error_Handle("Str_ConCatRemove", msMODULENAME, 1, _
"remove the string entries """ & sRemoveText & """" & vbCrLf & _
"from the following: """ & serrortext & """ string")
End Function

Str_ConCatReverse

Reverses the entries in a string concatenation.
Public Function Str_ConCatReverse( _
ByVal sText As String, _
Optional ByVal sSeperateChar As String = ";") As String

Const sPROCNAME As String = "Str_ConCatReverse"
Dim stemptext As String
Dim iseperatepos As String
On Error GoTo AnError

stemptext = ""
Do While sText <> ""
iseperatepos = InStr(sText, sSeperateChar)
If InStr(sText, sSeperateChar) > 0 Then
stemptext = sSeperateChar & Left$(sText, iseperatepos - 1) & stemptext
sText = Right(sText, Len(sText) - iseperatepos)
Else
stemptext = sText & stemptext
sText = ""
End If
Loop
Str_ConCatReverse = stemptext

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_ConCatReverse", msMODULENAME, 1, _
"return the reverse of the string concatenation " & vbCrLf & sText)
End Function

Str_CountOccurrences

Returns the number of occurrences of a string within another string.
Public Function Str_CountOccurrences( _
ByVal sText As String, _
ByVal sFindText As String, _
Optional lCompareMethod As Long) As Long

Const sPROCNAME As String = "Str_CountOccurrences"
Dim lPos As Long
Dim ltemp As Long
Dim lcount As Long
On Error GoTo ErrorHandler

lPos = 1
Do
lPos = InStr(lPos, sText, sFindText, lCompareMethod)
ltemp = lPos
If (lPos > 0) Then
lcount = lcount + 1
lPos = lPos + Len(sFindText)
End If
Loop Until (lPos = 0)
Str_CountOccurrences = lcount

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Function

Str_ExistsArray

Determines if a text string is equal to any of the possible entries in an array. Returns True or False.
Public Function Str_ExistsArray( _
ByVal sText As String, _
ParamArray vWords() As Variant) As Boolean

Const sPROCNAME As String = "Str_ExistsArray"
Dim vword As Variant
Dim scombine As String
On Error Resume Next

Str_ExistsArray = False
For Each vword In vWords
If sText = CStr(vword) Then
Str_ExistsArray = True
Exit Function
End If
Next vword

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"determine if the text """ & sText & """" & _
" equals one of the entries """ & ">>>>>>>")
End Function

Str_FindPositionOfOddSeq

Returns the position ?? TEST !!!.
Public Function Str_FindPositionOfOddSeq( _
ByVal sText As String, _
ByVal sCharLast As String, _
ByVal sCharSeq As String, _
ByVal iCharStart As Integer) As Integer

Const sPROCNAME As String = "Str_FindPositionOfOddSeq"
Dim icharpos As Integer
Dim icharsback As Integer
Dim bOddorEven As Boolean
On Error GoTo ErrorHandler

icharpos = iCharStart
Do While True
If Mid(sText, icharpos, 1) = sCharLast And _
Mid(sText, icharpos - 1, 1) = sCharSeq Then

bOddorEven = True
icharsback = 2
Do While Mid(sText, icharpos - icharsback, 1) = sCharSeq
If (bOddorEven = True) Then
bOddorEven = False
Else
bOddorEven = True
End If
icharsback = icharsback + 1
Loop
If (bOddorEven = True) Then
Str_FindPositionOfOddSeq = icharpos
End If
If (bOddorEven = True) Then
Exit Function
End If
End If
icharpos = icharpos + 1
Loop

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"")
End Function

Str_FullStopAdd

Returns a string ensuring that there is a full stop or char(?) at the end of it.
Public Function Str_FullStopAdd( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_FullStopAdd"
On Error GoTo ErrorHandler

If (Right(sText, 1) = ".") Then
Str_FullStopAdd = sText
End If
If (Right(sText, 1) <> ".") Then
Str_FullStopAdd = sText & "."
End If

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"add the full stop characater to the end of the text" & vbCrLf & _
"""" & sText & """")
End Function

Str_InBrackets

Returns the string in brackets that has been appended to a string ( ie FileName(2) ).
Public Function Str_InBrackets( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_InBrackets"
Dim iopenbracketpos As Integer
On Error GoTo ErrorHandler

iopenbracketpos = InStr(1, sText, "(")
Str_InBrackets = Mid(sText, iopenbracketpos + 1, Len(sText) - iopenbracketpos - 1)

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the string contained within the brackets from the string" & _
vbCrLf & """" & sText & """")
End Function

Str_InText

Determines if a string exists within another string as in a substring. Basically the Instr() function. Returns True or False.
Public Function Str_InText( _
ByVal sText As String, _
ByVal sFindText As String) As Boolean

Const sPROCNAME As String = "Str_InText"
Dim sfinaltext As String
Dim icount As Integer
On Error GoTo AnError

InStr() ???????????????

For icount = 1 To Len(sText)
If (Mid(sText, icount, Len(sFindText)) = sFindText) Then
Str_InText = True
Exit Function
Else
Str_InText = False
sfinaltext = sfinaltext & Mid(sText, icount, 1)
End If
Next icount

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"determine if the string """ & sFindText & """" & _
"exists in the string """ & sText & """")
End Function

Str_LastGet

Returns the last entry in a concatenated string.
Public Function Str_LastGet( _
ByVal sTextConcat As String, _
Optional ByVal sSeperateChar As String = ";", _
Optional ByVal bInformUser As Boolean = False) As String

Const sPROCNAME As String = "Str_LastGet"
Dim inextcharpos As Integer
On Error GoTo ErrorHandler

If (sTextConcat <> "") Then
inextcharpos = Str_CharsNoOf(sTextConcat, sSeperateChar)
If (inextcharpos = 1) Then
Str_LastGet = Left(sTextConcat, Len(sTextConcat) - 1)
sTextConcat = ""
Else
inextcharpos = 1
Do While Left(Right(Left(sTextConcat, Len(sTextConcat) - 1), _
inextcharpos), 1) <> sSeperateChar
inextcharpos = inextcharpos + 1
Loop
Str_LastGet = Right(sTextConcat, inextcharpos)
Str_LastGet = Left(Str_GetLast, Len(Str_GetLast) - 1)
End If
Else
Str_LastGet = ""
If bInformUser = True Then
Call Frm_Inform("", "There are no sub-strings to get")
End If
End If

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"obtain the last entry in the concatenated string" & vbCrLf & _
"""" & sTextConcat & """")
End Function

Str_LastNumber

Returns the number that is at the end of a string.
Public Function Str_LastNumber( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_LastNumber"
Dim sfinaltext As String
Dim icount As Integer
On Error GoTo ErrorHandler

For icount = 1 To Len(sText)
If (Asc(Mid(sText, icount, 1)) >= 48) And (Asc(Mid(sText, icount, 1)) <= 57) Then
Str_LastNumber = Right(sText, Len(sText) - icount + 1)
Exit Function
Else
sfinaltext = sfinaltext & Mid(sText, icount, 1)
End If
Next icount

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the number that is at the end of the string" & vbCrLf & _
"""" & sText & """")
End Function

Str_LinesNoOf

sdasdas.
Public Function Str_LinesNoOf( _
ByVal sText As String, _
ByVal iNoOfLines As Integer) As String

Const sPROCNAME As String = "Str_LinesNoOf"
Dim icharcr As Integer
Dim inoofcrs As Integer
Dim snewstring As String
On Error GoTo ErrorHandler

inoofcrs = Str_CharNoOf(stext)
snewstring = sText
For icharCr = inoofcrs To (iNoOfLines - 2)
snewstring = snewstring & Chr(13)
Next icharcr
Str_LinesNoOf = snewstring

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the number of lines ...")
End Function

Str_MiddleOf

Public Function Str_MiddleOf( _
ByVal sText As String, _
ByVal iRemoveRightlen As Integer, _
ByVal iRemoveLeftlen As Integer) As String

Const sPROCNAME As String = "Str_MiddleOf"
Dim shalfway As String
On Error Resume Next

shalfway = Right(sText, Len(sText) - iRemoveLeftlen)
Str_MiddleOf = Left(shalfway, Len(shalfway) - iRemoveRightlen)

If gbDEBUG_ERRMSG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the text in the middle of the string '" & sText & "'.")
End Function

Str_NextGet

Returns the next entry in a string concatenation.
Public Function Str_NextGet( _
ByVal sTextConcat As String, _
Optional ByVal sSeperateChar As String = ";", _
Optional ByVal bInformUser As Boolean = False) As String

Const sPROCNAME As String = "Str_NextGet"
Dim inextcharpos As Integer
On Error GoTo ErrorHandler

If sTextConcat <> "" Then
inextcharpos = InStr(1, sTextConcat, sSeperateChar)
If (inextcharpos > 0) Then
Str_NextGet = Left(sTextConcat, inextcharpos - 1)
Else
Str_NextGet = sTextConcat
sTextConcat = ""
End If
Else
Str_NextGet = ""
If bInformUser = True Then Call MsgBox("There are no sub-strings to get")
End If

If gbDEBUG_ERRMSG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"obtain the next entry in the concatenated string" & vbCrLf & _
"'" & sTextConcat & "'")
End Function

Str_NextRemove

Removes the next entry in a string concatenation.
Public Function Str_NextRemove( _
ByVal sTextConcat As String, _
Optional ByVal sSeperateChar As String = "", _
Optional ByVal bInformUser As Boolean = False) As String

Const sPROCNAME As String = "Str_NextRemove"
Dim inextcharpos As Integer
On Error GoTo ErrorHandler

If (sSeperateChar = "") Then
sSeperateChar = Chr(10)
End If
If InStr(sTextConcat, sSeperateChar) = 0 Then
Str_NextRemove = ""
Else
Str_NextRemove = Str_RightOf(sTextConcat, , sSeperateChar)
End If

If gbDEBUG_ERRMSG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"remove the next entry in the concatenated string" & vbCrLf & _
"'" & sTextConcat & "'")
End Function

Str_NoOfCRs

Returns the total number of carriage (ie Char(10)) returns in a text string.
Public Function Str_NoOfCRs( _
ByVal sTheText As String) As Integer

Const sPROCNAME As String = "Str_NoOfCRs"
Dim scurrenttext As String
Dim inoofCR As Integer
Dim inextCRno As Integer
On Error Resume Next

scurrenttext = sTheText
noofCR = 0
Do Until (scurrenttext = "")
inextCRno = Str_CharFindPositionofNext(scurrenttext, Chr(10))
If (inextCRno = -1) Then
scurrenttext = ""
Else
scurrenttext = Right(scurrenttext, Len(scurrenttext) - inextCRno)
inoofCR = inoofCR + 1
End If
Loop
Str_NoOfCRs = inoofCR

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the number of carriage returns in the text" & vbCrLf & _
"""" & sTheText & """")
End Function

Str_NumberFindPositionofNext

Returns the character position of the first occurrence of a number in a string.
Public Function Str_NumberFindPositionofNext( _
ByVal sText As String) As Integer

Const sPROCNAME As String = "Str_NumberFindPositionofNext"
Dim ifirstnumber As Integer
On Error Resume Next

' ifirstnumber = Str_FindPositionofNextChars(sText, _
' "0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
Str_FindPositionofNextNumber = ifirstnumber

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"return the character position of the next number in the string" & vbCrLf & _
"""" & sText & """")
End Function

Str_ParaCombine

Returns a string containing no carriage returns. Removes all carriage returns and adds full stops and capital letters to sentances.
Public Function Str_ParaCombine( _
ByVal sText As String, _
ByVal sSeperateChar As String, _
Optional ByVal bCapitalPrefix As Boolean = True, _
Optional ByVal bFullStop As Boolean = True) As String

Const sPROCNAME As String = "Str_ParaCombine"
Dim ichr13pos As Integer
Dim spara As String
Dim snewtext As String
On Error GoTo ErrorHandler

snewtext = ""
sText = Trim(sText)
Do While True
ichr13pos = InStr(1, sText, Chr(13))
If (ichr13pos = 0) Then
If (sText <> "" And bCapitalPrefix = True) Then
sText = Str_CharCapital(Left(sText, 1)) & Right(sText, Len(sText) - 1)
End If
If (sText <> "" And sSeperateChar = Chr(46)) Then
If (Right(sText, 1) <> Chr(46)) Then
sText = sText & Chr(46)
End If
End If
Para_Combine = snewtext & sText
Exit Do
End If
If (ichr13pos = 1) Then
sText = Trim(Right(sText, Len(sText) - 1))
End If
If (ichr13pos > 1) Then
spara = Trim(Left(sText, ichr13pos - 1))
If (bFullStop = True) Then
If (Right(spara, 1) <> Chr(46)) Then
spara = spara & sSeperateChar
End If
End If
spara = spara & Chr(32)
If (bCapitalPrefix = True) Then
spara = Str_CharCapital(Left(spara, 1)) & Right(spara, Len(spara) - 1)
End If
snewtext = snewtext & spara
sText = Trim(Right(sText, Len(sText) - ichr13pos))
End If
Loop

If gbDEBUG = False Then Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"remove all the carriage returns and ensure there are full stops and capital" & _
" letters from the text " & vbCrLf & """" & sText & """")
End Function

Str_ParaWidth

Returns the total width of the paragraph or line ??.
Public Function Str_ParaWidth( _
ByVal sTheText As String, _
ByVal bBold As Boolean) As Single

Const sPROCNAME As String = "Str_ParaWidth"
Dim scurrenttext As String
Dim sngtota As Single
Dim inextspaceno As Integer
Dim sngwordwidth As Single
On Error GoTo AnError

scurrenttext = sTheText
sngtotal = 0
Do Until (scurrenttext = "")
inextspaceno = Str_CharFindPositionofNext(scurrenttext, " ")
If inextspaceno = -1 Then inextspaceno = Len(scurrenttext)
sngwordwidth = Str_WordWidth(Left(scurrenttext, inextspaceno), bBold)
sngtotal = sngtotal + sngwordwidth
If (inextspaceno < Len(scurrenttext)) Then
scurrenttext = Right(scurrenttext, Len(scurrenttext) - inextspaceno)
Else
scurrenttext = ""
End If
Loop
Str_ParagraphWidth = sngtotal

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_ParaWidth", msMODULENAME, 1, _
"return the total width of a paragraph or line")
End Function

Str_ReplaceFunnyChars

Public Function Str_ReplaceFunnyChars( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_ReplaceFunnyChars"
Dim sitem As String
On Error GoTo ErrorHandler

sitem = sText
sitem = Replace(sitem, Chr(40), "0040") '(
sitem = Replace(sitem, Chr(41), "0041") ')
sitem = Replace(sitem, Chr(44), "0044") ',
sitem = Replace(sitem, Chr(45), "0045") '-
sitem = Replace(sitem, Chr(46), "0046") '.
sitem = Replace(sitem, Chr(47), "0047") '/
sitem = Replace(sitem, Chr(92), "0092") '[
sitem = Replace(sitem, Chr(93), "0093") ']
sitem = Replace(sitem, Chr(121), "0121") '\
sitem = Replace(sitem, Chr(214), "0214") 'O hat
sitem = Replace(sitem, Chr(226), "0226") 'a hat
sitem = Replace(sitem, Chr(228), "0228") 'a 2hats

sitem = Replace(sitem, Chr(39), "0039") '' apostrophe
sitem = Replace(sitem, Chr(43), "0043") '+
sitem = Replace(sitem, Chr(194), "0194") 'capital a hat
sitem = Replace(sitem, Chr(196), "0196") 'capital a 2 hats
sitem = Replace(sitem, Chr(200), "0200") 'capital e forward line
sitem = Replace(sitem, Chr(201), "0201") 'capital e backward line
sitem = Replace(sitem, Chr(205), "0205") 'capital i with dash
sitem = Replace(sitem, Chr(209), "0209") 'capital n with squiggle
sitem = Replace(sitem, Chr(211), "0211") 'capital o with backward line
sitem = Replace(sitem, Chr(220), "0220") 'capital u with 2 lines

Str_ReplaceFunnyChars = sitem

Exit Function
ErrorHandler:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Function

Str_ReplaceIfZorN

Returns the string unless it is either Null or equal to a zero ("0") then it returns another character if it is.
Public Function Str_ReplaceIfZorN( _
ByVal sText As String, _
Optional ByVal sReturnChar As String = " ") As String

Const sPROCNAME As String = "Str_ReplaceIfZorN"
On Error GoTo AnError

If (IsNull(sText) Or (sText = "0")) Then
Str_ReplaceIfZorN = sReturnChar
Else: Str_ReplaceIfZorN = sText
End If

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_ReplaceIfZorN", msMODULENAME, 1, _
"return the string " & vbCrLf & """" & sText & """" & vbCrLf & _
"substituting if it is Null or ""0""")
End Function

Str_Reverse

Returns a string with all the characters reversed.
Public Function Str_Reverse( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_Reverse"
Dim llength As Long
Dim lcharcounter As Long

On Error GoTo AnError
Str_Reverse = ""
llength = Len(sText)
For lcharcounter = llength To 1 Step -1
Str_Reverse = Str_Reverse & Mid(sText, lcharcounter, 1)
Next lcharcounter

If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
Call Error_Handle("Str_Reverse", msMODULENAME, _
"return the reverse of the string" & vbCrLf & _
"'" & sText & "'")
End Function

Str_RightOf

Public Function Str_RightOf( _
ByVal sText As String, _
Optional ByVal iRemoveFromLeft As Integer = 0, _
Optional ByVal sFirstCharFromLeft As String = "", _
Optional ByVal sFirstCharFromRight As String = "") As String

Const sPROCNAME As String = "Str_RightOf"
Dim icharposition As Integer
On Error GoTo AnError

If (iRemoveFromLeft <> 0) Then
Str_RightOf = Right(sText, Len(sText) - iRemoveFromLeft)
End If
If (sFirstCharFromLeft <> "") Then
icharposition = Str_CharFindPositionofNext(sText, sFirstCharFromLeft)

If (icharposition = -1) Then
Str_RightOf = sText
Else
Str_RightOf = Right(sText, Len(sText) - icharposition)
End If
End If
If (sFirstCharFromRight <> "") Then
icharposition = Str_CharFindPositionofNext(Str_Reverse(sText), sFirstCharFromRight)
Str_RightOf = Right(sText, icharposition - 1)
End If

If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
Call Error_Handle("Str_RightOf", msMODULENAME, _
"return remove " & iRemoveFromLeft & " characters " & _
"from the left of the string '" & sText * "'.")
End Function

Str_TextGetMatch

Returns a string given a sub string in a seperated string concatenation.
Public Function Str_TextGetMatch( _
ByVal sText As String, _
ByVal sSubStrText As String, _
Optional ByVal sSeparateChar As String = ";") As String

Const sPROCNAME As String = "Str_TextGetMatch"
Dim stemptext As String
Dim sfinaltext As String
Dim istartpos As Integer
Dim ifinishpos As Integer
On Error Goto AnError

istartpos = InStr(1, sText, sSubStrText)
If istartpos = 0 Then If Left(sText, 1) <> Left(sSubStrText, 1) Then istartpos = -1
If istartpos = -1 Then
Str_TextGetMatch = ""
Else
stemptext = Left(sText, istartpos - 1)
If InStr(1, stemptext, sSeparateChar < 1 Then
sfinaltext = Left(sText, Len(stemptext) + Len(sSubStrText))
Else
Do While istartpos > 0
If Right(stemptext, 1) = sSeparateChar Then
sfinaltext = sfinaltext & sSubStrText
istartpos = 0
Else
sfinaltext = Right(stemptext, 1) & sfinaltext
stemptext = Left(stemptext, Len(stemptext) - 1)
istartpos = istartpos - 1
End If
Loop
End If
ifinishpos = InStr(1, sText, sSubStrText) + Len(sSubStrText) - 1
stemptext = Right(sText, Len(sText) - ifinishpos)
Do While ifinishpos < Len(sText)
If Left(stemptext, 1) = sSeparateChar Then
ifinishpos = Len(sText)
Else
sfinaltext = sfinaltext & Left(stemptext, 1)
stemptext = Right(stemptext, Len(stemptext) - 1)
ifinishpos = ifinishpos + 1
End If
Loop
Str_TextGetMatch = sfinaltext
End If

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_TextGetMatch", msMODULENAME, 1, _
"returns a string given a sub string in a seperated string concatenation")
End Function

Str_TextReplace

Replaces all the occurances of a text string with a different text string.
Public Function Str_TextReplace( _
ByVal sText As String, _
ByVal sFindText As String, _
ByVal sReplaceText As String) As String

Const sPROCNAME As String = "Str_TextReplace"
Dim sfinaltext As String
Dim icount As Integer
On Error GoTo AnError

For icount = 1 To Len(sText) - Len(sFindText)
If Mid(sText, icount, Len(sFindText)) = sFindText Then
sfinaltext = sfinaltext & sReplaceText
icount = icount + Len(sFindText) - 1
Else
sfinaltext = sfinaltext & Mid(sText, icount, 1)
End If
Next icount
If Right(sText, Len(sFindText)) = sFindText Then
Str_TextReplace = sfinaltext
Else
Str_TextReplace = sfinaltext & Right(sText, Len(sFindText) - 1)
End If

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_TextReplace", msMODULENAME, 1, _
"replace the text """ & sFindText & """ and replace it with the text " & _
"""" & sReplaceText & """ in the string" & vbCrLf & """" & sText & """")
End Function

Str_TextToEnd

Returns a concatenation string having moved a particular text item to the end.
Public Function Str_TextToEnd( _
ByVal sText As String, _
ByVal sTextToMove As String, _
Optional ByVal sSeperateChar As String = ";") As String

Const sPROCNAME As String = "Str_TextToEnd"
Dim istartpos As Integer
Dim ifinishpos As Integer
On Error GoTo AnError

istartpos = InStr(1, sText, sTextToMove)
If istartpos = 0 Then If Left(sText, 1) <> Left(sTextToMove, 1) Then
istartpos = -1
End If
If istartpos = -1 Then
Str_TextToEnd = sText 'just return since there is more text
' text string cannot be found - include a bInformUser !!
Else
ifinishpos = istartpos + Len(sTextToMove)
Str_TextToEnd = Left(sText, istartpos - 1) + _
Right(sText, Len(sText) - ifinishpos) & sTextToMove & sSeperateChar
End If

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_TextToEnd", msMODULENAME, 1, _
"move the string """ & sTextToMove & """ to the end of the string " & _
"""" & sText & """")
End Function

Str_TextToStart

Returns a concatenation string having moved a particular text item to the start.
Public Function Str_TextToStart( _
ByVal sText As String, _
ByVal sTextToMove As String, _
Optional ByVal sSeperateChar As String = "") As String

Const sPROCNAME As String = "Str_TextToStart"
Dim istartpos As Integer
Dim ifinishpos As Integer
On Error GoTo AnError

istartpos = InStr(1, sText, sTextToMove)
If istartpos = 0 Then If Left(sText, 1) <> Left(sTextToMove, 1) Then istartpos = -1
If istartpos = -1 Then
Str_TextToStart = sText
' text string cannot be found - include a bInformUser !!
Else
ifinishpos = istartpos + Len(sTextToMove)
Str_TextToStart = sTextToMove & sSeperateChar & _
Left(sText, istartpos - 1) & Right(sText, Len(sText) - ifinishpos)
End If

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_TextToStart", msMODULENAME, 1, _
"move the string & """ & sTextToMove & """ to the start of the string " & _
"""" & sText & """")
End Function

Str_TickerCodeToSave

Removes any fullstops from a text string and replaces them with another character.
Public Function Str_TickerCode_ToSave( _
ByVal sTicker As String) As String

Const sPROCNAME As String = "Str_TickerCode_ToSave"
Dim idot As Integer
On Error GoTo AnError

idot = InStr(1, sTicker, ".")
If (idot > 0) Then
TickerCode_ToSave = Left(sTicker, idot - 1) & "#" & _
Right(sTicker, Len(sTicker) - idot)
Else
TickerCode_ToSave = sTicker
End If

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_TickerCode_ToSave", msMODULENAME, 1, _
"")
End Function

Str_TickerCodeToUse

Replaces any characters in a text string that should actually be fullstops.
Public Function Str_TickerCode_ToUse( _
ByVal sTicker As String) As String

Const sPROCNAME As String = "Str_TickerCode_ToUse"
Dim ihash As Integer
On Error GoTo AnError

ihash = InStr(1, sTicker, "#")
If (idot > 0) Then
TickerCode_ToUse = Left(sTicker, ihash - 1) & "." & _
Right(sTicker, Len(sTicker) - ihash)
Else
TickerCode_ToUse = sTicker
End If

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_TickerCode_ToUse", msMODULENAME, 1, _
"")
End Function

Str_ToArray

Transfers all the entries in a concatenated string to a single or multi dimensional array.
Public Sub Str_ToArray( _
ByVal sText As String, _
ByRef vArrayName As Variant, _
Optional ByVal sSeperateChar As String = ";")

Const sPROCNAME As String = "Str_ToArray"
Dim snextentry As String
Dim iarraycount As Integer
Dim inoofchars As Integer
On Error GoTo ErrorHandler

inoofchars = Str_CharsNoOf(sText, sSeperateChar)
If inoofchars > 0 Then
ReDim vArrayName(inoofchars)
iarraycount = 0
Do While Len(sText) > 0
If InStr(1, sText, sSeperateChar) = 0 Then
snextentry = sText
sText = ""
Else
snextentry = Left(sText, InStr(1, sText, sSeperateChar) - 1)
sText = Right(sText, Len(sText) - Len(snextentry) - 1)
End If
vArrayName(iarraycount) = snextentry
iarraycount = iarraycount + 1
Loop
End If

Exit Sub
ErrorHandler:
Call Error_Handle("Str_ToArray", msMODULENAME, 1, _
"split up the string" & vbCrLf & sText & vbCrLf & _
"separated by " & sSeperateChar & " and place them in an array")
End Sub

Str_ToBinary

Public Function Str_ToBinary(ByVal sText As String) As String

Dim bin As String
Dim j As Long
Dim str As String
Dim i As Long
Dim z As Double
Dim y As Double

bin = ""

For j = 1 To Len(sText)
str = Mid(sText, j, 1)

z = Asc(str)

For i = 7 To 0 Step -1
y = (2 ^ i)

bin = bin & Int(((z / y) - Int(((z / y) / 2)) * 2))
Next i
bin = bin & " "
Next j

Str_ToBinary = bin

End Function

Str_ToCharsArray

Seperates out all the characters from a string into an array.
Public Sub Str_ToCharsArray( _
ByVal sText As String, _
ByVal sArrayName As String, _
ByRef vArrayName As Variant)

Const sPROCNAME As String = "Str_CharsToArray"
Dim snextentry As String
On Error GoTo ErrorHandler

ReDim vArrayName(0)
Do While (Len(sText) > 0)
snextentry = Left(sText, 1)
vArrayName(UBound(vArrayName)) = snextentry
sText = Right(sText, Len(sText) - 1)
If sText <> "" Then
ReDim Preserve vArrayName(UBound(vArrayName) + 1)
End If
Loop

If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description, _
"split up the characters in """ & sText & """" & _
" and place them into the array """ & sArrayName & """")
End Sub

Public Function Str_ToCharsArray(ByVal sText As String)
Dim stemp As String
Dim vArray As Variant
stemp = StrConv(sText, vbUnicode)
vArray = Split(Left(stemp, Len(stemp) - 1, vbNullChar)
Str_ToCharsArray = vArray
End Function

Str_ToCollection

Public Function Str_ToCollection( _
ByVal sText As String, _
Optional ByVal sSeparateChar As String = ",") As Collection

Const sPROCNAME As String = "Str_ToCollection"
Dim objCollection As Collection
Dim snextentry As String

Do While Len(sText) > 0
If InStr(1, sText, sSeparateChar) = 0 Then
snextentry = sText
sText = ""
Else
snextentry = Left(sText, InStr(1, sText, sSeparateChar) - 1)
sText = Right(sText, Len(sText) - Len(snextentry) - 1)
End If

objCollection.Add snextentry
Loop

Set Str_ToCollection = objCollection

End Function

Str_ToDate

Public Function Str_ToDate( _
ByVal sDateValue As String, _
Optional ByVal sDateFormat As String = "dd/mm/yyyy") As String

Const sPROCNAME As String = "Str_ToDate"

Str_ToDate = Format(CDate(sDateValue), sDateFormat)

If gbDEBUG = False Then Exit Function

AnError:
Call Error_Handle("Str_ToDate", msMODULENAME, 1, _
"convert the date string ??")
End Function

Str_ToListComboBox

Transfers all the entries in a concatenated string to a single or multi column listbox or combobox.
Public Sub Str_ToListComboBox( _
ByVal sText As String, _
ByVal lstBoxName As Control, _
Optional ByVal sSeparateChar As String = ";", _
Optional ByVal sRowChar As String = "#", _
Optional ByVal bSelectIfOne As Boolean = True)

Const sPROCNAME As String = "Str_ToListComboBox"
Dim iseparatepos As Integer
Dim seachone As String
On Error GoTo AnError

lstBoxName.Clear
Do While Len(sText) > 0
iseparatepos = InStr(sText, sSeparateChar)
If InStr(1, sText, sSeparateChar) > 0 Then
lstBoxName.AddItem Left(sText, iseparatepos - 1)
sText = Right(sText, Len(sText) - iseparatepos)
Else
lstBoxName.AddItem sText
sText = ""
End If
Loop
If lstBoxName.ListCount = 1 And bSelectIfOne = True Then lstBoxName.ListIndex = 0

If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Str_ToListComboBox", msMODULENAME, 1, _
"transfer the concatenated string to the control '" & lstBoxName.Name & "'.")
End Sub

Str_ToTextFile

Transfers all the entries in a concatenated string to a textfile.
Public Sub Str_ToTextFile( _
ByVal sText As String, _
ByVal sFolderPath As String, _
ByVal sTextFile As String, _
Optional ByVal sExtension As String = ".txt", _
Optional ByVal sSeparateChar As String = "#")

Const sPROCNAME As String = "Str_ToTextFile"
Dim iFileNo As Integer
Dim snextentry As String
Dim iseparatepos As Integer
On Error GoTo AnError

iFileNo = FreeFile 'get the next free file number
sTextFile = sFolderPath & sTextFile & sExtension
Open sTextFile For Output As iFileNo

Do While Len(sText) > 0
iseparatepos = InStr(1, sText, sSeparateChar)
If (iseparatepos > 0) Then
snextentry = Left(sText, iseparatepos - 1)
Print #iFileNo, snextentry
sText = Right(sText, Len(sText) - Len(snextentry) - 1)
Else
Print #iFileNo, sText
sText = ""
End If
Loop

Close iFileNo

If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("File_Exists", msMODULENAME, 1, _
"transfer the concatenated string " & vbCrLf & _
"""" & sText & """" & vbCrLf & _
"to the following text file:" & vbCrLf & _
sFolderPath & sTextFile & sExtension)
End Sub

Str_ValueReturn

Public Function Str_ValueReturn( _
ByVal sTextNumber As String) As Single

If IsNumeric(sTextNumber ) = True Then
Str_ValueReturn= CSng(sTextNumber )
Else
Str_ValueReturn= 0
End If
End Function

Str_WidthParagraph

Returns the total width of a paragraph.
Public Function Str_WidthParagraph( _
ByVal sText As String, _
ByVal bBold As Boolean) As Single

Const sPROCNAME As String = "Str_WidthParagraph"
Dim inextspaceno As Integer
Dim sngwordwidth As Single
Dim sngtotal As Single
On Error GoTo AnError

sngtotal = 0
Do Until (sText = "")
inextspaceno = InStr(1, sText, " ")
If inextspaceno = -1 Then inextspaceno = Len(sText)
sngwordwidth = Str_WidthWord(Left(sText, inextspaceno), bBold)
sngtotal = sngtotal + sngwordwidth
If (inextspaceno < Len(sText)) Then
sText = Right(sText, Len(sText) - inextspaceno)
Else
sText = ""
End If
Loop
Str_WidthParagraph = sngtotal

Exit Function
AnError:
Call Error_Handle("Str_WidthParagraph", msMODULENAME, 1, _
"return the total width of the paragraph" & vbCrLf & """" & sText & """")
End Function

Str_WidthWidest

Returns the line that has the widest number of characters in it and returns the width of all these characters.
Public Function Str_WidthWidest( _
ByVal sText As String, _
ByVal bBold As Boolean) As Single

Const sPROCNAME As String = "Str_WidthWidest"
Dim scurrenttext As String
Dim inextCRno As Integer
Dim sngparawidth As Single
Dim maxparawidth As Single
On Error GoTo AnError

scurrenttext = sText
maxparawidth = 0
Do Until (scurrenttext = "")

' assumes seperated by Chr(10)
inextCRno = Str_FindPositionofNextChar(scurrenttext, Chr(10))
If inextCRno = -1 Then
sngparawidth = Str_WidthParagraph(Left(scurrenttext, Len(scurrenttext)), bBold)
Else
sngparawidth = Str_WidthParagraph(Left(scurrenttext, inextCRno - 2), bBold)
End If
If sngparawidth > maxparawidth Then maxparawidth = sngparawidth 'increment max
If (inextCRno = -1) Then
scurrenttext = ""
Else
scurrenttext = Right(scurrenttext, Len(scurrenttext) - inextCRno)
End If
Loop
Str_WidthWidest = maxparawidth

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_WidthWidest", msMODULENAME, 1, _
"return the total width of the widest paragraph in the text" & vbCrLf & sText)
End Function

Str_WordCount

Public Function Str_WordCount()
End Sub

Str_WordFirst

Public Function Str_WordFirst( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_WordFirst"
Dim ispace As Integer
On Error GoTo AnError

ispace = Instr(1, sText, " ")
If ispace > 0 Then Str_WordFirst = Left(sText, ispace - 1)
If ispace = 0 Then Str_WordFirst = sText

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_WordFirst", msMODULENAME, 1, _
"obtain the first word from """ & sText & """")
End Function

Str_WordLast

Public Function Str_WordLast( _
ByVal sText As String) As String

Const sPROCNAME As String = "Str_WordLast"
Dim ispace As Integer
On Error GoTo AnError

If Instr(1, sText, " ") = -1 Then
Str_WordLast = ""
Exit Function
End If
Do While Instr(1, sText, " ") > 0 Then
ispace = Instr(1, sText, " ")
sText = Right(sText, len(sText) - ispace)
Loop
Str_WordLast = sText

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_WordLast", msMODULENAME, 1, _
"obtain the last word from '" & sText & "'.")
End Function

Str_WordReplace

Public Function Str_WordReplace( _
ByVal sText As String, _
ByVal sFindStr As String, _
ByVal sReplaceStr As String) As String

Const sPROCNAME As String = "Str_WordReplace"
Dim aText() As String
Dim lcount As Long

On Error GoTo AnError
aText = Split(sText)
For lcount = LBound(aText) To UBound(aText)
If aText(lcount) Like sFindStr Then
aText(lcount) = sReplaceStr
End If
Next lcount

Str_WordReplace = Join(aText)
Exit Function
AnError:

End Function

Str_WordWidth

Returns the total width of characters in a word.
Public Function Str_WordWidth( _
ByVal sWord As String, _
ByVal bBold As Boolean) As Single

Const sPROCNAME As String = "Str_WordWidth"
Dim sChar As String
Dim scurrenttext As String
Dim sngtotalwidth As Single
On Error GoTo AnError

sngtotalwidth = 0
Do Until (sWord = "")
sChar = Left(sWord, 1)
sngtotalwidth = sngtotalwidth + Char_Tahoma8Reg(sChar)
' If bBold = True Then sngtotalwidth = sngtotalwidth + Char_RegularWidth(sChar)
' If bBold = False Then sngtotalwidth = sngtotalwidth + Char_Tahoma8Reg(sChar)
sWord = Right(sWord, Len(sWord) - 1)
Loop
Str_WordWidth = sngtotalwidth

If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Str_WordWidth", msMODULENAME, 1, _
"return the total width of the characters in the string """ & sWord & """")
End Function

© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited Top