|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (ActiveX/Controles/DLL)
|
|
 |
Título da Dica: Tirar acentos de strings (Muito util p/ quem imprimi direto na lpt1)
|
 |
|
|
|
Postada em 8/5/2004 por Lancer
Public Function TiraAcentos(ByVal sTexto As String) As String
Dim sAcentos(2, 11) As String
Dim sCaracter As String
Dim bAcentos As Boolean
Dim i As Integer, j As Integer
sAcentos(1, 1) = "á"
sAcentos(2, 1) = "a"
sAcentos(1, 2) = "é"
sAcentos(2, 2) = "e"
sAcentos(1, 3) = "í"
sAcentos(2, 3) = "i"
sAcentos(1, 4) = "ó"
sAcentos(2, 4) = "o"
sAcentos(1, 5) = "ú"
sAcentos(2, 5) = "u"
sAcentos(1, 6) = "ê"
sAcentos(2, 6) = "e"
sAcentos(1, 7) = "ô"
sAcentos(2, 7) = "o"
sAcentos(1, 8) = "ã"
sAcentos(2, 8) = "a"
sAcentos(1, 9) = "º"
sAcentos(2, 9) = "o"
sAcentos(1, 10) = "ç"
sAcentos(2, 10) = "c"
sAcentos(1, 11) = "Ã"
sAcentos(2, 11) = "A"
TiraAcentos = sTexto 'Coloca o texto original como retorno
For i = 1 To Len(sTexto)
sCaracter = Mid$(sTexto, i, 1) 'Testa cada caracter
If Asc(sCaracter) = 39 Or Asc(sCaracter) >= 192 And Asc(sCaracter) <= 255 Then
bAcentos = True 'Indica a presença de acentos
Exit For
End If
Next
If bAcentos = True Then
'Comparamos cada caracter com os elementos da matriz
For i = 1 To Len(sTexto)
For j = 1 To 11
sCaracter = Mid$(sTexto, i, 1)
If Asc(sCaracter) >= 192 And Asc(sCaracter) <= 255 Then
If sCaracter = sAcentos(1, j) Then
Mid$(sTexto, i, 1) = sAcentos(2, j)
TiraAcentos = sTexto
End If
End If
Next
Next
End If
End Function
'Para chamar..
TiraAcentos(String)
|
|
|
|
|
