FUNCAO PARA TIRAR ACENTUACAO

BORBOLETATY 05/01/2011 09:00:29
#361143
bom dia a todos, alguem por acaso tem alguma funcao para tirar acentuacao dos campos em tempo de execucao? ou seja gravar sem acentos?
XXXANGELSXXX 05/01/2011 09:05:20
#361145 Resposta escolhida
em um modulo
   
Public Function f_RemoveAcento(ByVal Texto As String) As String
    Dim i As Long
    Dim troca As String
    If Len(Texto) = 0 Then Exit Function
    For i = 1 To Len(Texto)
        troca = Empty
        Select Case Mid(Texto, i, 1)
        Case [Ô]Á[Ô]: troca = [Ô]A[Ô]
        Case [Ô]á[Ô]: troca = [Ô]a[Ô]
        Case [Ô]ã[Ô]: troca = [Ô]a[Ô]
        Case [Ô]Ã[Ô]: troca = [Ô]A[Ô]
        Case [Ô]â[Ô]: troca = [Ô]a[Ô]
        Case [Ô]Â[Ô]: troca = [Ô]A[Ô]
        Case [Ô]à[Ô]: troca = [Ô]a[Ô]
        Case [Ô]À[Ô]: troca = [Ô]A[Ô]
        Case [Ô]Ó[Ô]: troca = [Ô]O[Ô]
        Case [Ô]ó[Ô]: troca = [Ô]o[Ô]
        Case [Ô]õ[Ô]: troca = [Ô]o[Ô]
        Case [Ô]Õ[Ô]: troca = [Ô]O[Ô]
        Case [Ô]Ô[Ô]: troca = [Ô]O[Ô]
        Case [Ô]ô[Ô]: troca = [Ô]o[Ô]
        Case [Ô]é[Ô]: troca = [Ô]E[Ô]
        Case [Ô]é[Ô]: troca = [Ô]e[Ô]
        Case [Ô]Ê[Ô]: troca = [Ô]E[Ô]
        Case [Ô]ê[Ô]: troca = [Ô]e[Ô]
        Case [Ô]ç[Ô]: troca = [Ô]c[Ô]
        Case [Ô]Ç[Ô]: troca = [Ô]C[Ô]
        Case [Ô]Í[Ô]: troca = [Ô]I[Ô]
        Case [Ô]í[Ô]: troca = [Ô]i[Ô]
        Case [Ô]ü[Ô]: troca = [Ô]u[Ô]
        Case [Ô]Ü[Ô]: troca = [Ô]U[Ô]
        Case [Ô]ú[Ô]: troca = [Ô]u[Ô]
        Case [Ô]|[Ô]: troca = [Ô][Ô]
        Case [Ô][Ô]: troca = [Ô][Ô]
        Case [Ô][Ô]: troca = [Ô][Ô]
        Case [Ô]||[Ô]: troca = [Ô]e[Ô]
        Case [Ô]º[Ô], [Ô]~[Ô], [Ô]'[Ô], [Ô]'[Ô], [Ô][Ô][Ô][Ô], [Ô]  [Ô], [Ô]:[Ô], [Ô][ô][Ô]: troca = [Ô] [Ô]
        End Select

        [ô]Substituir letras
        If troca <> Empty Then Mid(Texto, i, 1) = troca
    Next i
    f_RemoveAcento = Texto
End Function


para chamar a funcao
f_RemoveAcento(text1.text)
Tópico encerrado , respostas não são mais permitidas
Voltar