De: Onildo Souto Lira Enviado: Fri May 27 21:25
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
|
domingo, 23 de setembro de 2018