sábado, 17 de março de 2007

Retirar acentos

Código para retirar acentos de um texto no Excel.

Function RetAcento(Texto As String) As String
Dim Completo As String
Dim Tamanho As Long
Dim CodAsc As Integer
Dim Posicao As Long
Tamanho = Len(Texto)
For Posicao = 1 To Tamanho
CodAsc = Asc(Mid(Texto, Posicao, 1))
Select Case CodAsc
Case 192 To 197
CodAsc = Asc("A")
Case 224 To 229
CodAsc = Asc("a")
Case 200 To 203
CodAsc = Asc("E")
Case 232 To 235
CodAsc = Asc("e")
Case 204 To 207
CodAsc = Asc("I")
Case 236 To 239
CodAsc = Asc("i")
Case 210 To 214
CodAsc = Asc("O")
Case 242 To 246
CodAsc = Asc("o")
Case 217 To 220
CodAsc = Asc("U")
Case 249 To 252
CodAsc = Asc("u")
Case 209
CodAsc = Asc("N")
Case 241
CodAsc = Asc("n")
End Select
Completo = Completo & Chr(CodAsc)
Next
PosicaoRetAcento = Completo
End Function

Nenhum comentário:

Pesquisar este blog

Arquivo do blog

Quem sou eu

Minha foto
Administrador de Empresas/Técnico em Processamento de Dados. Microsoft Office User Specialist - Excel Proficient. Pós-graduado em Business Intelligence.