Newsgroup: it.comp.appl.access
Titolo: parole con apostrofo e i numeri romani

Un ciao a tutto il N.G.,
Ho un problema che proprio mi affigge.
Sulla mia maschera, per gestire le parole con apostrofo e i numeri
romani uso la funzione che ho trovato a questo link:
http://www.mvps.org/access/strings/str0008.htm
 (è la stessa che ho
postato di sotto)
Devo dire che funziona molto bene, l'ho inserita sull'evento KeyDown e
così per ogni textbox dopo il tab mi mette tutto il testo per bene,
senza spazi etc...
Sul sito dove l'ho presa dice che può essere modificata per ogni uso.
Così quello che vorrei fare è alterarla in modo che mi se scrivo
''pippo spa'' dopo il codice mi restituisce ''pippo S.p.A.'' magari
punti inclusi!
In altre parole dovrei riuscire ha maneggiare queste tipologie di
parole: (S.r.l. S.p.A. s.n.c. s.a.s. S.r.l.u.) Cioè, comunque le
scrivo vorrei ottenere sempre il formato corretto, che quello tra
parentesi.
Grazie in anticipo a chiunque vorrà aiutarmi
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  *************


Ma non fai prima con la replace?
Es.
if instr(1,me!stringa,"spa") > 0 then
    me!stringa = replace(me!stringa,"spa","S.p.A",1)
end if
Ciao.
-- 
Sergio MAZZA 

 Sergio MAZZA
Ciao Sergio,
ottima idea, secondo te come potrei integrare il pezzo del tuo codice
dentro quel modulo?
Sono molto scarso con VBA e non ci riesco a farlo da me.
Però mi farebbe comodo che stesse lì perchè nella form la chiamo così:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim retval As String
    If KeyCode = vbKeyTab Then
        Screen.ActiveControl.Text =
mixed_case(Screen.ActiveControl.Text)
End If
End Sub
Grazie tanto per il tuo interessamento.
Stefano

 Stefano
La funzione (replace) la dovresti utilizzare (per es.) all'uscita della 
casella di testo (evento "su uscita")...
Ciao.
-- 
Sergio MAZZA 


Vespa Spa diventa VeS.p.A. S.p.A.
Baffetti da sparviero diventa Baffetti da S.p.A.rviero
Piiiippo, piiiippo....
-- 
-- 
MAssimiliano Amendola
www.accessgroup.it
Cisa - Conferenza Italiana Sviluppatori Access

 >>http://www.mvps.org/access/strings/str0008.htm(è la stessa che ho

Hai ragione, infatti l'idea di Sergio era buona ma non completa, non
riesco ancora ad uscire da questo problema.
Il modulo a cui mi riferisco sopra tiene bene conto degli accenti e
dei numeri romani, credo si debba scrive una funzione del tipo di
quella che converte i numeri romani.
Ma non sono in grado di farlo.... credi si possa fare?
Ciao e grazie dell'interessamento...
Stefano


Vincenzo Turturro 
Certificato Eucip Core Level 
ITA 0000-002299 del 14/05/2007 
--------------------------------------------- 
il sito comune di it.comp.appl.access: 
http://www.sitocomune.com
 
--------------------------------------------- 
risorse Access: 
http://www.accessgroup.it
 
--------------------------------------------- 
Il sito comune di it.comp.as400 
http://www.faq400.com
 
---------------------------------------------


Scusa non riesco a capire, come devo fare?
Qual'è mi sembra uguale a quella di Sergio o sbaglio?


Rispetto a quella di Sergio c'è uno spazio prima ed uno dopo.


On 20 Set, 11:11, V...@Work.it (VT @ Work) wrote:

Hai ragione, scusa ora ho capito.
Sembra funzionare bene
Ciao!