Para: ativoaccess@ativoaccess.com.br Prioridade: Normal
Assunto: Funcao para remover acentos de strings Tipo: Embeded HTML/Text
Estou encaminhando esta rotina para remover acentos em strings, pode ser utilizada para varias rotinas entre elas, criacao de arquivos txt para importacao, impressão em impressoras matricias, etc.
Um Abraco, Onildo Lira
Function RemoverAcentos(Str As String) As String
Dim ComAcento As String
Dim SemAcento As String
Dim x As Integer
Dim NovaStr, cAtual As String
ComAcento = "àâêôûãõáéíóúçüÀÂÊÔÛÃÕÁÉÍÓÚÇÜ"
SemAcento = "aaeouaoaeioucuAAEOUAOAEIOUCU"
For x = 1 To Len(Str)
cAtual = Mid(Str, x, 1)
If InStr(1, ComAcento, cAtual, vbBinaryCompare) <> 0 Then
cAtual = Mid(SemAcento, InStr(1, ComAcento, cAtual, vbBinaryCompare), 1)
End If
NovaStr = NovaStr + cAtual
Next
RemoverAcentos = NovaStr
End Function
quinta-feira, 21 de setembro de 2017
