USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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)
 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página