Microsoft Office Forums - View Single Post

drcz · 05-08-2016, 01:11 PM

HI,

I saw a function created by Paul Edstein / macropod few years ago which I cannot make it to work in my case.
What I need: if an word is containing any capital letter then that word to start with a Capital letter. If the word is written in lowercases had to be left as it is

ThIs TeXT has to bE transformed wITh CaPITAL LETTERS
into
This Text has to Be transformed With Capital Letters

I spent all day long but I could not find proper solution

Code:

Function ProperCase(StrTxt As String, Optional Caps As Long, Optional Excl As Long) As String
'Convert an input string to proper-case.
'Surnames like O', Mc and hyphenated names are converted to proper case also.
'If Caps = 0, then upper-case strings like ABC are preserved; otherwise they're converted.
'If Excl = 0, selected words are retained as lower-case, except when they follow specified punctuation marks.
Dim i As Long, j As Long, k As Long, l As Long, bChngFlg As Boolean
Dim StrTmpA As String, StrTmpB As String, StrExcl As String, StrPunct As String, StrChr As String
StrExcl = " a , an , and , as , at , but , by , for , from , if , in , is , of , on , or , the , this , to , with "
StrPunct = "!,:,.,?,"""
If Excl <> 0 Then
  StrExcl = ""
  StrPunct = ""
End If
If Len(Trim(StrTxt)) = 0 Then
  ProperCase = StrTxt
  Exit Function
End If
If Caps <> 0 Then StrTxt = LCase(StrTxt)
StrTxt = " " & StrTxt & " "
For i = 1 To UBound(Split(StrTxt, " "))
  StrTmpA = " " & Split(StrTxt, " ")(i) & " "
  StrTmpB = UCase(Left(StrTmpA, 2)) & Right(StrTmpA, Len(StrTmpA) - 2)
  StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)
Next i
StrTxt = Trim(StrTxt)
'Code for handling O' names
For i = 1 To UBound(Split(StrTxt, "'"))
  ' If InStr(Right(Split(StrTxt, "'")(i - 1), 2), " ") = 1 Then
  If InStr(Right(Split(StrTxt, "'")(i - 1), 2), " ") = 1 Or _
    Right(Split(StrTxt, "'")(i - 1), 2) = Right(Split(StrTxt, "'")(i - 1), 1) Then
    StrTmpA = Split(StrTxt, "'")(i)
    StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1)
    StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)
  End If
Next
'Code for handling hyphenated names
For i = 1 To UBound(Split(StrTxt, "-"))
  StrTmpA = Split(StrTxt, "-")(i)
  StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1)
  StrTxt = Replace(StrTxt, StrTmpA, StrTmpB)
Next
'Code for handling names starting with Mc
If Left(StrTxt, 2) = "Mc" Then
  Mid(StrTxt, 3, 1) = UCase(Mid(StrTxt, 3, 1))
End If
i = InStr(StrTxt, " Mc")
If i > 0 Then
  Mid(StrTxt, i + 3, 1) = UCase(Mid(StrTxt, i + 3, 1))
End If
'Code for handling names starting with Mac
If Left(StrTxt, 3) = "Mac" Then
  If Len(Split(Trim(StrTxt), " ")(0)) > 5 Then
    Mid(StrTxt, 4, 1) = UCase(Mid(StrTxt, 4, 1))
  End If
End If
i = InStr(StrTxt, " Mac")
If i > 0 Then
  If Len(StrTxt) > i + 5 Then
    Mid(StrTxt, i + 4, 1) = UCase(Mid(StrTxt, i + 4, 1))
  End If
End If
'Code to restore excluded words to lower case
For i = 0 To UBound(Split(StrExcl, ","))
  StrTmpA = Split(StrExcl, ",")(i)
  StrTmpB = UCase(Left(StrTmpA, 2)) & Right(StrTmpA, Len(StrTmpA) - 2)
  If InStr(StrTxt, StrTmpB) > 0 Then
    StrTxt = Replace(StrTxt, StrTmpB, StrTmpA)
    'Make sure an excluded words following punctution marks are given proper case anyway
    For j = 0 To UBound(Split(StrPunct, ","))
      StrChr = Split(StrPunct, ",")(j)
      StrTxt = Replace(StrTxt, StrChr & StrTmpA, StrChr & StrTmpB)
    Next
  End If
Next
ProperCase = StrTxt
End Function