MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    eliminar apóstrofe

    Compartilhe

    poy
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 71
    Registrado : 10/01/2012

    eliminar apóstrofe

    Mensagem  poy em Sex 03 Jan 2014, 16:09

    Pesquisando no fórum descobri o código abaixo de autoria do Hary Shon que me atenderia perfeitamente.

    Colei os códigos no meu sistema e fiz um call (VerifApostrofe) mas me dá um erro de compilação "falta identificador)

    Onde está o erro ?

    Public Function VerifApostrofe(Texto As String) As String
    Dim TextoAux() As String, Resultado As String
    Dim I As Long, TotAp As Integer
    If InStr(Texto, "'") = 0 Then
    VerifApostrofe = Texto
    Exit Function
    End If
    TotAp = ItemCount(Texto, "'")
    For I = 1 To TotAp
    ReDim Preserve TextoAux(I)
    TextoAux(I - 1) = Item(Texto, Int(I), "'")
    Next
    Resultado = TextoAux(0)
    For I = 1 To TotAp - 1
    Resultado = Resultado & "''" & TextoAux(I)
    Next
    VerifApostrofe = Resultado
    End Function

    Public Function ItemCount(Texto As String, Car As String) As Long
    Dim pos As Long
    Dim I As Long
    I = 1
    pos = 1
    Do While True
    pos = InStr(pos, Texto, Car)
    If pos = 0 Then
    If I = 1 Then I = 0
    Exit Do
    End If
    pos = pos + 1
    I = I + 1
    Loop
    ItemCount = I
    End Function

    Public Function Item(Texto As String, NrItem As Long, Separador As String) As String
    Dim MyText As String
    Dim Resposta As String
    Dim Elem() As String
    Dim I As Long
    Dim pos As Long
    Dim TotItens As Long

    TotItens = ItemCount(Texto, Separador)
    If TotItens = 0 Or _
    NrItem > TotItens Then
    Resposta = Texto
    Else
    MyText = Texto
    ReDim Elem(TotItens)
    For I = 1 To TotItens
    pos = InStr(MyText, Separador)
    If pos <> 0 Then
    pos = (pos - 1) + Len(Separador)
    Elem(I - 1) = Left(MyText, pos)
    If InStr(Elem(I - 1), Separador) <> 0 Then
    Elem(I - 1) = Left(Elem(I - 1), Len(Elem(I - 1)) - Len(Separador))
    End If
    MyText = Right(MyText, Len(MyText) - pos)
    Else
    Elem(I - 1) = MyText
    End If
    If I = NrItem Then Exit For
    Next
    Resposta = Elem(NrItem - 1)
    End If
    Item = Resposta
    End Function

    avatar
    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3384
    Registrado : 04/04/2010

    Re: eliminar apóstrofe

    Mensagem  Avelino Sampaio em Dom 05 Jan 2014, 07:46

    Olá, Poy!

    Não analisei sua função mas acho que poderia simplicar bastante se utilizar a função REPLACE()

    Exemplos:

    replace("Avelino 'Sampaio' e torcedor do 'Fluminense'","'","")

    replace(me!NomeCampoTexto,"'","")

    Sucesso!

      Data/hora atual: Sab 22 Jul 2017, 05:43