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

    Busca em campo Memo por mais de uma palavra simultaneamente

    Compartilhe
    avatar
    HARYSOHN
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 12233
    Registrado : 01/03/2011

    Busca em campo Memo por mais de uma palavra simultaneamente

    Mensagem  HARYSOHN em Ter 21 Ago 2012, 22:17

    Partindo do consagrado exemplo do Mestre João Paulo, uma adaptação para busca por mais de uma palavra simultaneamente:


    >>>>> Aqui é necessário digitar as palavras separadas por uma "," (Vírgula) <<<<<<

    Private Sub cmdEncontrar_Click()
    On Error Resume Next
    Dim StrBusca As String 'Variável do tipo String
    Dim StrBuscaArray 'Variável do tipo Array
    'Carrego a variável com o texto da caixa texto no form
    StrBusca = Me.txtProcura
    'Carrego a variável com o conteúdo da Variável StrBusca, separando-as pela vírgula, colocando cada palavra em uma posição da Array. Inicia na posição 0
    StrBuscaArray = Split(StrBusca, ",")

    'Utilizo o For para executar N Loops de acordo com a quantidade de posições dentro da Matriz, sendo a maior posição estraída pelo comando Ubound. Aqui a cada laço o valor de X é incrementado de acordo com a posição da informação na Matriz
    For x = 0 To UBound(StrBuscaArray)

    If IsNull(Me!CampoMemo) Or IsNull(Me!txtProcura) Then Exit Sub
    Dim StrSelecao As Integer]
    'Aqui a modificação para carregar a variável StrSeleção com o texto contido na Matriz na posição X (que será modificada a cada Volta)
    StrSelecao = Len(StrBuscaArray(x))
    If strPosicao = 0 Then strPosicao = 1
    'Substituido conforme a busca. A ser executada na Matriz
    strPosicao = InStr(strPosicao, Me!CampoMemo, StrBuscaArray(x))
    If strPosicao > 0 Then
    Me!CampoMemo.SetFocus
    Me!CampoMemo.SelStart = strPosicao - 1
    Me!CampoMemo.SelLength = StrSelecao
    strPosicao = strPosicao + 1
    Else
    'Emite a menssagem para a palavra não encontrada
    MsgBox "Não foi encontrada a seguinte palavra" & "'" & StrBuscaArray(x) & "'" & "", vbExclamation, "Erro"
    'Vai para a o rótulo onde se inicia a busca pela próxima palavra
    GoTo Continuar
    strPosicao = 1
    Dim rs As Recordset
    Set rs = Me.RecordsetClone
    rs.Bookmark = Me.Bookmark '
    rs.MoveNext
    If rs.EOF Then
    If MsgBox("Procura terminada." & vbCrLf & "", vbDefaultButton2 + vbYesNo + vbQuestion, "Erro") = vbYes Then
    rs.MoveFirst
    Me.Bookmark = rs.Bookmark
    Me!txtProcura = Null
    Me!txtProcura.SetFocus
    strContagem = 0
    Else
    End If
    Else
    Me.Bookmark = rs.Bookmark
    End If
    End If
    'Vai para o proximo valor de X
    Continuar: 'Não encontrada a palavra vai para este rotulo e por consequencia a proxima palavra
    Next x
    Set rs = Nothing
    End Sub


    Resumindo... Se digitarmos 2 palavras (Nome, Access)
    A variável assumira a seguinte forma e posição:

    StrBuscaArray(0) = Nome
    StrBuscaArray(0) = Access

    Assim se buscará todas as palavras.



    [Você precisa estar registrado e conectado para ver este link.]

    Cumprimentos.


    .................................................................................
    PILOTO
    الله أكبر Paz, Justiça e Liberdade! الله أكبر
    [Você precisa estar registrado e conectado para ver este link.]

    Iniciando no Access? Então veja esse [Você precisa estar registrado e conectado para ver este link.] e também [Você precisa estar registrado e conectado para ver este link.]


    [Você precisa estar registrado e conectado para ver este link.]

    Quando tua dúvida for RESOLVIDA, dê retorno com AGRADECIMENTO a aqueles que gastaram seu tempo em te ajudar.
    Clique no botão Resolvido logo acima do botão Enviar, do lado direito. Todos nós agradecemos.  
    [Você precisa estar registrado e conectado para ver esta imagem.]

      Data/hora atual: Qua 18 Out 2017, 10:24