Acentuacao ja existente. Como substituir?

[Duvidas_Duvidosas 0]

Pessoal,

Eu estou consertando um campo (Nome do Cliente) em que não era para ter acentos, mas já tem muitos registros inseridos com acento.

O KeyPress - para os próximos registros - já esta adicionado, mas para substituir os acentos, já existentes, está muito complicado.

 

Já tentei de muitas formas.

Já tentei desta forma...

 

DescricaoDaPeca1 = DescricaoPeca.Text
DescricaoDaPeca2 = Left(DescricaoDaPeca1, 1)
DescricaoDaPeca3 = UCase(DescricaoDaPeca2)
DescricaoDaPeca4 = Mid(DescricaoDaPeca1, 2, 255)
DescricaoPeca.Text = Replace(DescricaoDaPeca2, DescricaoDaPeca2, DescricaoDaPeca3 & DescricaoDaPeca4)


Function retiraacentos(ByVal s As String) As String

Dim i As Integer
Dim c As String
Dim r As String
s = UCase(s)
r = ""
If Len(i) > 0 Then
For i = 1 To Len(s)
c = UCase(Mid$(s, i, 1))
Select Case c
Case "Á", "À", "Ã", "Â", "Ä"
c = "A"
Case "á", "à", "ã", "â", "ä"
c = "a"

Case "É", "È", "Ê", "Ë"
c = "E"
Case "é", "è", "ê", "ë"
c = "e"

Case "Ì", "Í", "Î", "Ï"
c = "I"
Case "í", "ì", "î", "ï"
c = "i"

Case "Ó", "Ò", "Õ", "Ô", "Ö"
c = "O"
Case "ó", "ò", "õ", "ô", "ö"
c = "o"

Case "Ú", "Ù", "Û", "Ü"
c = "U"
Case "ú", "ù", "û", "ü"
c = "u"

Case "Ç"
c = "C"
Case "ç"
c = "c"
End Select
r = r + c
Next
End If
retiraacentos = r


[size=3][color="navy"]
Já tentei na maretada....[/color][/size]

LimpaVariaveis
DescricaoDaPeca1 = DescricaoPeca.Text
DescricaoPosicao = InStr(DescricaoDaPeca1, "Á")
If DescricaoPosicao > 0 Then
MsgBox LetraAsubstituir
LetraAsubstituir = "A"
MsgBox LetraAsubstituir
MsgBox DescricaoPosicao
DescricaoAntesPosicao = Left(DescricaoDaPeca1, DescricaoPosicao - 1)
DescricaoCont = Len(DescricaoDaPeca1)
DescricaoPosPosicao = Right(DescricaoDaPeca1, DescricaoCont - DescricaoPosicao)
MsgBox DescricaoAntesPosicao
MsgBox DescricaoPosPosicao
MsgBox DescricaoCont
DescricaoSemAcento = DescricaoAntesPosicao & LetraAsubstituir & DescricaoPosPosicao
DescricaoPeca = DescricaoSemAcento
End If

LimpaVariaveis
DescricaoDaPeca1 = DescricaoPeca.Text
DescricaoPosicao = InStr(DescricaoDaPeca1, "á")
If DescricaoPosicao > 0 Then
MsgBox LetraAsubstituir
LetraAsubstituir = "a"
MsgBox LetraAsubstituir
MsgBox DescricaoPosicao
DescricaoAntesPosicao = Left(DescricaoDaPeca1, DescricaoPosicao - 1)
DescricaoCont = Len(DescricaoDaPeca1)
DescricaoPosPosicao = Right(DescricaoDaPeca1, DescricaoCont - DescricaoPosicao)
MsgBox DescricaoAntesPosicao
MsgBox DescricaoPosPosicao
MsgBox DescricaoCont
DescricaoSemAcento = DescricaoAntesPosicao & LetraAsubstituir & DescricaoPosPosicao
DescricaoPeca = DescricaoSemAcento
End If

Isso tudo no LostFocus do campo em questao.

O problema,no segundo caso, esta que ele começa testando os “A” maiúsculos identifica e substitui certinho, quando ele chega nos “a” minúsculos ele identifica minúsculo mas substitui por A maiúsculo.

 

Já tentei Select case, já tentei if/elseIf/Else....

 

O que eu quero é que ele verifique se existe acento, caso exista substitua pela letra sem acento, sem alterar para maiuscula ou minuscula.

 

Desde ja agradeço a atencao.

[scorpio 7]

Qual banco usa ?

 

 

Tente comparar assim:

If (StrComp("a", "A", vbBinaryCompare)) Then
MsgBox "diferente"
Else
MsgBox "igual"
End If

[Claudio Neto 3]

Olá. Mas você está fazendo isso nessa linha:

 

c = UCase(Mid$(s, i, 1))

Ou seja, você está passando para c o valor da sua variável sempre em maiúsculo, então quando chega na parte da comparação sempre será "Á", e nunca "á".

 

Retire o Ucase. E outra coisa, não entendi que relação tem sua primeira parte do código com sua função. Não achei a parte em que você chama a função. Se postou e eu que não vi me desculpe.

 

Se não der certo avise.

 

Ah, e procure colocar seus códigos sempre dentro de tags

 

Abraços.

[Duvidas_Duvidosas 0]

O Banco é Access.

Na verdade o código que esta na tag são duas maneiras diferentes que eu tentei.

A primeira que vai até retiraacentos = r, a segunda do LimpaVariaveis em diante.

Eu não estou usando o primeiro codigo porque nao estou conseguindo chamar a funcao retiraacentos dentro de outras funcoes como Replace ou InStr. Estou tentando fazer no segundo codigo, letra por letra e estou chamando a funcao no lost_focus da text DescricaoPeca.

Quanto as tags, desculpe, eu não sabia.

 

Obrigada pela atencao.

 

Duvidas_Duvidosas

[Claudio Neto 3]

Olha, sinceramente estou até com dificuldades para entender sua rotina.

 

Mas vou tentar postar algo mais simplificado a partir do que você já tem.

 

Farei algumas alterações na sua função retiraacentos, ficando assim:

Function retiraacentos(nome As String) As String
dim i as integer

for i = 1 to len(nome)

c = mid(nome,i,1)
Select Case c
Case "Á", "À", "Ã", "Â", "Ä"
c = "A"

Case "á", "à", "ã", "â", "ä"
c = "a"

Case "É", "È", "Ê", "Ë"
c = "E"

Case "é", "è", "ê", "ë"
c = "e"

Case "Ì", "Í", "Î", "Ï"
c = "I"

Case "í", "ì", "î", "ï"
c = "i"

Case "Ó", "Ò", "Õ", "Ô", "Ö"
c = "O"

Case "ó", "ò", "õ", "ô", "ö"
c = "o"

Case "Ú", "Ù", "Û", "Ü"
c = "U"

Case "ú", "ù", "û", "ü"
c = "u"

Case "Ç"
c = "C"

Case "ç"
c = "c"

End Select

retiraacentos = retiraacentos & c

next
end sub

Agora chame sua função assim:

 

private sub txtNome.lostfocus

txtnome.text = retiraacentos(txtnome.text)

end sub

Sendo txtnome a textobox que está recebendo a palavra que você quer desacentuar.

 

Se tiver algum errinho me avise, fiz de cabeça e não testei.

 

Abraços.