Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
Discussion GroupsFormsForms ProgrammingQueriesModules / DAO / VBAReports / PrintingMacrosDatabase DesignSecurityConversionImporting / LinkingSQL Server / ADPMultiuser / NetworkingReplicationSetup / ConfigurationDeveloper ToolkitsActiveX ControlsNew UsersGeneral 1General 2
Access DirectoryToolsTutorialsUser Groups
Related Topics
SQL ServerOther DB ProductsMS OfficeMore Topics ...

MS Access Forum / Forms Programming / January 2005

Tip: Looking for answers? Try searching our database.

Mixed Case

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
Ivan Grozney - 19 Jan 2005 01:41 GMT
I found this code on the MVPS.ORG site.  I have been
trying to use it but I get a

       Compile Error:
    SUB or FUNCTION not found.

I have put into a CLASS MODULE and inserted the code as a
procedure but I cannot get it to work. Anyone have a guess
as to somethings I might be doing wrong?

Thanks
Ivan

Strings: Names with Mixed cases
Author(s)
    Jay Holovacs




   This set of functions allow developers to handle
special rules of name spellings. It is modular so that
additional rules for other nationalities can be easily
added.
For example it handles names such as:
Henry VIIIK.
O'Hara
Tom McHill
Mary Smith - Jones
Call the function with the name passed in any state of
capitalization, returned value is correctly capitalized
(original argument is not modified, making it suitable for
use in queries).
dim retval as string
retval=mixed_case("joe mcdonald")
'************** Code Start *************
'This code was originally written by Jay Holovacs.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,  
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Jay Holovacs
'
Public Function mixed_case(str As Variant) As String
'returns modified string, first character of each word us
uppercase
'all others lower case
Dim ts As String, ps As Integer, char2 As String
   If IsNull(str) Then
       mixed_case = ""
       Exit Function
   End If
   str = Trim(str) 'added 11/22/98
   If Len(str) = 0 Then
       mixed_case = ""
       Exit Function
   End If
   ts = LCase$(str)
   ps = 1
   ps = first_letter(ts, ps)
   special_name ts, 1 'try to fix the beginning
   Mid$(ts, 1) = UCase$(Left$(ts, 1))
   If ps = 0 Then
       mixed_case = ts
       Exit Function
   End If
   While ps <> 0
       If is_roman(ts, ps) = 0 Then 'not roman, apply the
other rules
           special_name ts, ps
           Mid$(ts, ps) = UCase$(Mid$(ts, ps,
1)) 'capitalize the first letter
       End If
       ps = first_letter(ts, ps)
   Wend
   mixed_case = ts
End Function
Private Sub special_name(str As String, ps As Integer)
'expects str to be a lower case string, ps to be the
'start of name to check, returns str modified in place
'modifies the internal character (not the initial)

Dim char2 As String
char2 = Mid$(str, ps, 2) 'check for Scots Mc
If (char2 = "mc") And Len(str) > ps + 1 Then '3rd char is
CAP
   Mid$(str, ps + 2) = UCase$(Mid$(str, ps + 2, 1))
End If

char2 = Mid$(str, ps, 2) 'check for ff
If (char2 = "ff") And Len(str) > ps + 1 Then 'ff form
   Mid$(str, ps, 2) = LCase$(Mid$(str, ps, 2))
End If

char2 = Mid$(str, ps + 1, 1) 'check for apostrophe as 2nd
char
If (char2 = "'") Then '3rd char is CAP
   Mid$(str, ps + 2) = UCase$(Mid$(str, ps + 2, 1))
End If

Dim char3 As String
char3 = Mid$(str, ps, 3) 'check for scots Mac
If (char3 = "mac") And Len(str) > ps + 1 Then 'Mac form
   Mid$(str, ps + 3) = UCase$(Mid$(str, ps + 3, 1))
End If

Dim char4 As String
char4 = Mid$(str, ps, 4) 'check for Fitz
If (char4 = "fitz") And Len(str) > ps + 1 Then 'Fitz form
   Mid$(str, ps + 4) = UCase$(Mid$(str, ps + 4, 1))
End If

End Sub
Private Function first_letter(str As String, ps As
Integer) As Integer
'ps=starting point to search (starts with character AFTER
ps)
'returns next first letter, 0 if no more left
'modified 6/18/99 to handle hyphenated names
Dim p2 As Integer, p3 As Integer, s2 As String
   s2 = str
   p2 = InStr(ps, str, " ") 'points to next blank, 0 if
no more
   p3 = InStr(ps, str, "-") 'points to next hyphen, 0 if
no more
   If p3 <> 0 Then
       If p2 = 0 Then
           p2 = p3
       ElseIf p3 < p2 Then
           p2 = p3
       End If
   End If
   If p2 = 0 Then
       first_letter = 0
       Exit Function
   End If
   'first move to first non blank, non punctuation after
blank
   While is_alpha(Mid$(str, p2)) = False
       p2 = p2 + 1
       If p2 > Len(str) Then 'we ran off the end
           first_letter = 0
           Exit Function
       End If
   Wend
   first_letter = p2
End Function
Public Function is_alpha(ch As String)
'returns true if this is alphabetic character
'false if not
   Dim c As Integer
   c = Asc(ch)
   Select Case c
       Case 65 To 90
           is_alpha = True
       Case 97 To 122
           is_alpha = True
       Case Else
           is_alpha = False
   End Select
   
End Function
Private Function is_roman(str As String, ps As Integer) As
Integer
'starts at position ps, until end of word. If it appears
to be
'a roman numeral, than the entire word is capped in passed
back
'string, else no changes made in string
'returns 1 if changes were made, 0 if no change
Dim mx As Integer, p2 As Integer, flag As Integer, i As
Integer
   mx = Len(str) 'just so we don't go off the edge
   p2 = InStr(ps, str, " ") 'see if there is another
space after this word
   If p2 = 0 Then
       p2 = mx + 1
   End If
   'scan to see if any inappropriate characters in this
word
   flag = 0
   For i = ps To p2 - 1
       If InStr("ivxIVX", Mid$(str, i, 1)) = 0 Then
           flag = 1
       End If
   Next i
   If flag Then
       is_roman = 0
       Exit Function 'this is not roman numeral
   End If
   Mid$(str, ps) = UCase$(Mid$(str, ps, p2 - ps))
   is_roman = 1
End Function
'************** Code End  *************
PC Datasheet - 19 Jan 2005 04:17 GMT
Yes, the code is invisible!

--
                                       PC Datasheet
Your Resource For Help With Access, Excel And Word Applications
                             resource@pcdatasheet.com
                                www.pcdatasheet.com

> I found this code on the MVPS.ORG site.  I have been
> trying to use it but I get a
[quoted text clipped - 189 lines]
> End Function
> '************** Code End  *************
Marshall Barton - 19 Jan 2005 06:02 GMT
>I found this code on the MVPS.ORG site.  I have been
>trying to use it but I get a
[quoted text clipped - 5 lines]
>procedure but I cannot get it to work. Anyone have a guess
>as to somethings I might be doing wrong?

Put it in a standard module.

Signature

Marsh
MVP [MS Access]

 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.