Results 1 to 3 of 3
  1. #1
    Star Lounger
    Join Date
    Feb 2002
    Posts
    56
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Proper Case (A2000)

    I use the following to convert to proper case

    Public Function Proper()
    Screen.ActiveControl = StrConv(Screen.ActiveControl, vbProperCase)
    End Function

    Does any-one have a better code for this to recognise things like McDonald, etc

    Dave

  2. #2
    Silver Lounger
    Join Date
    Jun 2001
    Location
    Niagara Falls, New York, USA
    Posts
    1,878
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Proper Case (A2000)

    Hi Dave

    Search the internet with google.com for neatcode.zip

    Another lounger might help you with a link.

    look at the following 2 function and sub:

    HTH

    John


    Sub ParseName(ByVal S As String, Title As String, fName As String, MName As String, LName As String, Pedigree As String, Degree As String)
    '
    ' Parses name "Mr. Bill A. Jones III, PhD" into separate fields.
    ' Words are extracted in the following order: Title, Degree, Pedigree, LName, FName, MName
    ' Assumes Pedigree is not preceded by a comma, or else it will end up with the Degree(s).
    '
    Dim Word As String, P As Integer, Found As Integer
    Const Titles = "Mr.Mrs.Ms.Dr.Mme.Mssr.Mister,Miss,Doctor,Sir,Lord ,Lady,Madam,Mayor,President"
    Const Pedigrees = "Jr.Sr.III,IV,VIII,IX,XIII"
    Title = ""
    fName = ""
    MName = ""
    LName = ""
    Pedigree = ""
    Degree = ""
    '
    ' Get Title
    '
    'Word = CutWord(S, S)
    Word = CutFirstWord(S, S)
    If InStr(Titles, Word) Then
    Title = Word
    Else
    S = Word & " " & S
    End If
    '
    ' Get Degree
    '
    P = InStr(S, ",")
    If P > 0 Then
    Degree = Trim$(Mid$(S, P + 1))
    S = Trim$(left$(S, P - 1))
    End If
    '
    ' Get Pedigree
    '
    Word = CutLastWord(S, S)
    If InStr(Pedigrees, Word) Then
    Pedigree = Word
    Else
    S = S & " " & Word
    End If
    '
    ' Get Last Name
    '
    LName = CutLastWord(S, S)
    '
    ' Get First Name
    '
    'fName = CutWord(S, S)
    fName = CutFirstWord(S, S)
    '
    ' Get Middle Name(s)
    '
    MName = Trim(S)
    End Sub
    ==============
    Function ProperLookup(ByVal InText As Variant) As Variant
    '
    ' Similar to Proper(), but uses a table (NAMES) to look up words that don't fit the
    ' general formula.
    '
    Dim OutText As String, Word As String, i As Integer, C As String
    Dim Db As DATABASE, t As Recordset
    '
    ' Output Null and other non-text as is
    '
    If VarType(InText) <> 8 Then
    ProperLookup = InText
    Else
    Set Db = CurrentDb
    Set t = Db.OpenRecordset("Names", dbOpenTable)
    t.Index = "PrimaryKey"
    OutText = ""
    Word = ""
    For i = 1 To Len(InText)
    C = Mid$(InText, i, 1)
    Select Case C
    Case "A" To "Z" ' if text, then build word
    Word = Word & C
    Case Else
    If Word <> "" Then ' if not, then append existing word and then the character
    t.Seek "=", Word
    If t.NoMatch Then
    Word = UCase(left(Word, 1)) & LCase(Mid(Word, 2))
    Else
    Word = t!Name
    End If
    OutText = OutText & Word
    Word = ""
    End If
    OutText = OutText & C
    End Select
    Next i
    '
    ' Process final word
    '
    If Word <> "" Then
    t.Seek "=", Word
    If t.NoMatch Then
    Word = UCase(left(Word, 1)) & LCase(Mid(Word, 2))
    Else
    Word = t!Name
    End If
    OutText = OutText & Word
    End If
    '
    ' Close table and return result
    '
    t.Close
    Db.Close
    ProperLookup = OutText
    End If
    End Function

  3. #3
    3 Star Lounger
    Join Date
    Dec 2000
    Location
    USA
    Posts
    379
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Proper Case (A2000)

    Haven't used it, but check out this link. The comments specifically mention the case of McDonald.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •