COVERTER CARACTER PARA CODIGO ASCII NA IMPRESSAO

BETOPMJB 26/04/2010 10:56:50
#340250
galera eu preciso de uma rotina se alguem tiver para impressão de acentos em DOS tipo João josé, quando é feita a impressão em DOS sai outro caisa.

alguem teria essa rotina??
TECLA 10/05/2010 20:58:22
#341460
Não seria mais fácil RETIRAR o acento da palavra?
XXXANGELSXXX 14/05/2010 13:32:05
#341773
Amigo, voce imprime atraves de PRINT. PRINTER ?

Se for, tire os acentos, ou configure o teclado para portugues brasileiro.

Caso contrario.. olha ai uma funcao para tirar os acentos

 
Public Function f_RemoveAcento(ByVal Texto As String) As String
    Dim i As Long
    Dim troca As String
    If Len(Texto) = 0 Then Exit Function
    For i = 1 To Len(Texto)
        troca = Empty
        Select Case Mid(Texto, i, 1)
            Case [Ô]Á[Ô]: troca = [Ô]A[Ô]
            Case [Ô]á[Ô]: troca = [Ô]a[Ô]
            Case [Ô]ã[Ô]: troca = [Ô]a[Ô]
            Case [Ô]Ã[Ô]: troca = [Ô]A[Ô]
            Case [Ô]â[Ô]: troca = [Ô]a[Ô]
            Case [Ô]Â[Ô]: troca = [Ô]A[Ô]
            Case [Ô]à[Ô]: troca = [Ô]a[Ô]
            Case [Ô]À[Ô]: troca = [Ô]A[Ô]
            Case [Ô]Ó[Ô]: troca = [Ô]O[Ô]
            Case [Ô]ó[Ô]: troca = [Ô]o[Ô]
            Case [Ô]õ[Ô]: troca = [Ô]o[Ô]
            Case [Ô]Õ[Ô]: troca = [Ô]O[Ô]
            Case [Ô]Ô[Ô]: troca = [Ô]O[Ô]
            Case [Ô]ô[Ô]: troca = [Ô]o[Ô]
            Case [Ô]é[Ô]: troca = [Ô]E[Ô]
            Case [Ô]é[Ô]: troca = [Ô]e[Ô]
            Case [Ô]Ê[Ô]: troca = [Ô]E[Ô]
            Case [Ô]ê[Ô]: troca = [Ô]e[Ô]
            Case [Ô]ç[Ô]: troca = [Ô]c[Ô]
            Case [Ô]Ç[Ô]: troca = [Ô]C[Ô]
            Case [Ô]Í[Ô]: troca = [Ô]I[Ô]
            Case [Ô]í[Ô]: troca = [Ô]i[Ô]
            Case [Ô]ü[Ô]: troca = [Ô]u[Ô]
            Case [Ô]Ü[Ô]: troca = [Ô]U[Ô]
            Case [Ô]ú[Ô]: troca = [Ô]u[Ô]
            Case [Ô]º[Ô], [Ô]~[Ô], [Ô]'[Ô], [Ô]'[Ô], [Ô][Ô][Ô][Ô], [Ô]  [Ô], [Ô]:[Ô]
                troca = [Ô] [Ô]
        End Select

        [ô]Substituir letras
        If troca <> Empty Then Mid(Texto, i, 1) = troca
    Next i
    f_RemoveAcento = Texto
End Function
Tópico encerrado , respostas não são mais permitidas
Voltar