R
riccifs
Hi to everyone the N.G.,
I have another a big clue for you.
To handle names with mixed cases, on my form, I'm using the code I
have found at this web-link:
http://www.mvps.org/access/strings/str0008.htm (I posted it just
below)
It works great and it should be modular so that it possible to add
additional rules to handle special sequences of characters.
What I'd like to do is to add a code, to be able to transform for
example, ''John spa'' to ''John S.p.A.''
My trouble is that any time I write spa and I do that hundred of
times, I have to remember to hit the point after each letter.
It will be great if it doesn't matter how I to write ''spa'', the code
after a keydown event, will change it in ''S.p.A.''' for me.
If you look the last part of the code you'll see a function to handle
roman number. If you write ''vii'' the code will change in ''VII'' for
you.
Could you think is possible to do something like that? I'm not
absolutely able to that, so I was thinking about you.
The word I'd be able to handle in the way I described before are:
S.r.l. S.p.A. s.n.c. s.a.s. S.r.l.u.
I hope someone will be give to me an hand.....!
Thanks,
Stefano.
'************** 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 *************
I have another a big clue for you.
To handle names with mixed cases, on my form, I'm using the code I
have found at this web-link:
http://www.mvps.org/access/strings/str0008.htm (I posted it just
below)
It works great and it should be modular so that it possible to add
additional rules to handle special sequences of characters.
What I'd like to do is to add a code, to be able to transform for
example, ''John spa'' to ''John S.p.A.''
My trouble is that any time I write spa and I do that hundred of
times, I have to remember to hit the point after each letter.
It will be great if it doesn't matter how I to write ''spa'', the code
after a keydown event, will change it in ''S.p.A.''' for me.
If you look the last part of the code you'll see a function to handle
roman number. If you write ''vii'' the code will change in ''VII'' for
you.
Could you think is possible to do something like that? I'm not
absolutely able to that, so I was thinking about you.
The word I'd be able to handle in the way I described before are:
S.r.l. S.p.A. s.n.c. s.a.s. S.r.l.u.
I hope someone will be give to me an hand.....!
Thanks,
Stefano.
'************** 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 *************