esercitazione con VBA su Powerpoint perconversione di lettere con apice in lettere accentate
http://digilander.libero.it/francescovise/vbacodice/converte.htmhttp://digilander.libero.it/francescovise/vbacodice/converte.ppthttp://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