Option Explicit
Function TranslateChar(StrIn As String) As String
Dim Counter As Long
Static coll As Collection
Dim Check As String
Dim WasLower As Boolean
Dim Letter As String
If coll Is Nothing Then
Set coll = New Collection
coll.Add Item:="a", Key:="?"
coll.Add Item:="a", Key:="?"
coll.Add Item:="a", Key:="?"
coll.Add Item:="a", Key:="?"
coll.Add Item:="a", Key:="?"
coll.Add Item:="a", Key:="?"
coll.Add Item:="ae", Key:="?"
coll.Add Item:="c", Key:="?"
coll.Add Item:="e", Key:="?"
coll.Add Item:="e", Key:="?"
coll.Add Item:="e", Key:="?"
coll.Add Item:="e", Key:="?"
coll.Add Item:="i", Key:="?"
coll.Add Item:="i", Key:="?"
coll.Add Item:="i", Key:="?"
coll.Add Item:="i", Key:="?"
coll.Add Item:="n", Key:="?"
coll.Add Item:="o", Key:="?"
coll.Add Item:="o", Key:="?"
coll.Add Item:="o", Key:="?"
coll.Add Item:="o", Key:="?"
coll.Add Item:="o", Key:="?"
coll.Add Item:="oe", Key:="?"
coll.Add Item:="ss", Key:="?"
coll.Add Item:="th", Key:="?"
coll.Add Item:="th", Key:="?"
coll.Add Item:="u", Key:="?"
coll.Add Item:="u", Key:="?"
coll.Add Item:="u", Key:="?"
coll.Add Item:="u", Key:="?"
coll.Add Item:="y", Key:="?"
coll.Add Item:="y", Key:="?"
coll.Add Item:="dollar", Key:="$"
End If
For Counter = 1 To Len(StrIn)
On Error Resume Next
Letter = Mid(StrIn, Counter, 1)
Check = coll(Letter)
WasLower = (StrComp(Letter, LCase(Letter), vbBinaryCompare) = 0)
If Err <> 0 Then
Err.Clear
Check = Letter
End If
On Error GoTo 0
TranslateChar = TranslateChar & IIf(WasLower, LCase(Check), StrConv(Check, vbProperCase))
Next
End Function
|