Substituindo todos os acentos em um texto.

Outro dia recebi uma consulta sobre como eliminar os caracteres acentuados de um texto. Na verdade o texto fora importado de uma base de dados padro ISAM ( dbase , Fox Pro , Paradox ) e deveria ser usada em uma outra fonte de dados de forma que os caracteres acentuados iriam causar muitos problemas e deveriam ser removidos. Assim , , deve tornar-se e ; , , , deve virar a , e assim por diante...

Para resolver o problema s criar uma funo que substitua esses caracteres pelos correspondentes sem acento. Muito esperto !! Para faze isto s dar uma olhada na tabela ASCII de caracteres onde temos o cdigo que representa cada caractere:

 128 160 [space] 192 224
129 161 193 225
130 162 194 226
131 163 195 227
132 164 196 228
133 165 197 229
134 166 198 230
135 167 199 231
136 168 200 232
137 169 201 233
138 170 202 234
139 171 203 235
140 172 204 236
141 173 205 237
142 174 206 238
143 175 207 239
144 176 208 240
145 177 209 241
146 178 210 242
147 179 211 243
148 180 212 244
149 181 213 245
150 182 214 246
151 183 215 247
152 184 216 248
153 185 217 249
154 186 218 250
155 187 219 251
156 188 220 252
157 189 221 253
158 190 222 254
159 191 223 255

Observe que os cdigos para , , , , correspondem aos cdigos 192, 192, 193 ... , 197. Deu para pegar a idia ??? A funo deve receber o texto e verificar caracterer por caracter contra os cdigos da tabela a cima , substituindo-os pelos respectivos caracteres sem acento... Vamos a dita cuja.

Private Function Limpa_Texto(texto As String)
Dim texto_limpo As String
Dim Codigo_Tabela_Asc As Integer
Dim posicao As Long

For posicao = 1 To Len(texto)
Codigo_Tabela_Asc = Asc(Mid(texto, posicao, 1))
  Select Case Codigo_Tabela_Asc
     Case 192 To 197
        Codigo_Tabela_Asc = Asc("A")
     Case 224 To 229
        Codigo_Tabela_Asc = Asc("a")
     Case 200 To 203
        Codigo_Tabela_Asc = Asc("E")
     Case 232 To 235
        Codigo_Tabela_Asc = Asc("e")
     Case 204 To 207
        Codigo_Tabela_Asc = Asc("I")
     Case 236 To 239
        Codigo_Tabela_Asc = Asc("i")
     Case 199
        Codigo_Tabela_Asc = Asc("C")
     Case 231
        Codigo_Tabela_Asc = Asc("c")
  End Select
  texto_limpo = texto_limpo & Chr(Codigo_Tabela_Asc)
Next

Limpa_Texto = texto_limpo

End Function

A funo acima no esta completa , eu apenas mostrei como substituir as ocorrncias de acentos nos caracteres: A,a,E,e,I,i, e . Cabe a voc agora expandir a funo de acordo com sua necessidade. Quer saber como usar ???

Bem basta chamar a funo passando o texto a ser limpo , assim : texto_limpo = limpa_Texto(texto)

At a prxima...