sperimentare

esercitazione con VBA su Powerpoint perconversione di lettere con apice in lettere accentate

http://digilander.libero.it/francescovise/vbacodice/converte.htm
http://digilander.libero.it/francescovise/vbacodice/converte.ppt
http://digilander.libero.it/francescovise/vbacodice/converte.GIF

Private Sub CommandButton1_Click()
Dim testo1 As String
Dim testo2 As String

ListBox1.AddItem "la funzione converte analizza le singole lettere "
ListBox1.AddItem "del testo inserito "
ListBox1.AddItem "se il carattere che segue una lettera risulta un apice "
ListBox1.AddItem "potrebbe essere un accento se la lettera è una vocale "
ListBox1.AddItem "oppure un apostrofo, se la lettera non è una vocale "
ListBox1.AddItem "se la lettera risulta una vocale si esegue la sua trasformazione "
ListBox1.AddItem "riscrivendola accentata "
ListBox1.AddItem ("-------------------------------------------------------------")
testo1 = "cona'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "cone'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "coni'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "conu'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "cono'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
ListBox1.AddItem ("----------------------")
testo1 = "conà"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "cona"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
ListBox1.AddItem ("-------------------")
testo1 = "conA'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "conE'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "conI'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "conU'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
testo1 = "conO'"
prova1 = (converte(testo1))
ListBox1.AddItem (testo1 & " " & prova1)
ListBox1.AddItem ("--------------------------")
testo2 = "cona' e cone'"
prova2 = converte(testo2)
ListBox1.AddItem (testo2 & " " & prova2)
ListBox1.AddItem ("--------------------------")
testo2 = "cona' e all'altezza"
prova2 = converte(testo2)
ListBox1.AddItem (testo2 & " " & prova2)
ListBox1.AddItem ("--------------------------")


End Sub

Function converte(testo As String) As String
Rem conversione vocali finali con apice
Rem in vocali con accento es. a' > à
Rem lascia invariato testo se assente apice a > a à > à
Rem non considera o apostrofato es. poco > po'
Rem A' > À

Dim ciclo As Boolean
Dim p As Integer
ciclo = True
p = 1

While (ciclo) 'esegue mentre ciclo risulta true
'cessa se incontra spazio vuoto
'considera carattere seguente :se spazio finisce ciclo
If Mid$(testo, p, 1) = "" Then
ciclo = False

Else
If Mid$(testo, p + 1, 1) = "'" Then
Select Case Mid$(testo, p, 1)
Case "a"
converte = converte & "à"
p = p + 2
Case "e"
converte = converte & "é"
p = p + 2
Case "i"
converte = converte & "ì"
p = p + 2
Case "u"
converte = converte & "ù"
p = p + 2
Case "o"
converte = converte & "ò"
p = p + 2

Case "A"
converte = converte & "À"
p = p + 2

Case "E"
converte = converte & "Ê"
p = p + 2

Case "I"
converte = converte & "Ì"
p = p + 2

Case "U"
converte = converte & "Ù"
p = p + 2

Case "O"
converte = converte & "Ò"
p = p + 2

Case Else
converte = converte & Mid$(testo, p, 1)
p = p + 1
End Select

Else
converte = converte & Mid$(testo, p, 1)
p = p + 1
End If
End If
Wend

End Function