Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Formulario de pesquisa

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
wesantos
Acabou de chegar
Acabou de chegar
Mensagens: 7
Registrado em: Qui Jan 20, 2011 6:03 pm

Formulario de pesquisa

Mensagem por wesantos »

Olá a todos do Forum, sou novato no VBA e vasculhando na net a respeito encontrei este codigo que em suma esta adaptado para a minha planilha, o probleminha e que na pesquisa e vasculha a planilha por completo e me retorna tudo mais tudo mesmo com um certo caractere, o que eu quero saber como faço para que esta pesquisa ocorra somente na coluna A na D e I da planilha ?

Segue o codigo e desde já acrescento que este forum e uns dos melhores da NET que abordam o Excel e suas infinitas possibilidades.



Public MatrizResultados As Variant
Public Total_Ocorrencias As Long


Private Sub btn_Procurar_Click()
If Me.txt_Procurar.Value = "" Then
MsgBox "Digite um valor para a pesquisa"
Else
Call ProcuraPersonalizada(Me.txt_Procurar.Value)
End If
End Sub




Private Sub SpinButton1_Change()
Dim Linha As Long
Dim TotalOcorrencias As Long


TotalOcorrencias = SpinButton1.Max + 1
Linha = MatrizResultados(SpinButton1.Value)

Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
TextBox1.Text = Plan1.Cells(Linha, 1).Value
TextBox2.Text = Plan1.Cells(Linha, 2).Value
TextBox3.Text = Format(Plan1.Cells(Linha, 3).Value, "h:mm;@")
TextBox4.Text = Plan1.Cells(Linha, 4).Value
TextBox5.Text = Plan1.Cells(Linha, 5).Value
TextBox6.Text = Plan1.Cells(Linha, 6).Value
TextBox7.Text = Plan1.Cells(Linha, 7).Value
TextBox8.Text = Plan1.Cells(Linha, 8).Value
TextBox9.Text = Plan1.Cells(Linha, 9).Value
TextBox10.Text = Plan1.Cells(Linha, 10).Text
TextBox11.Text = Plan1.Cells(Linha, 11).Text
TextBox12.Text = Plan1.Cells(Linha, 12).Text
TextBox15.Text = Plan1.Cells(Linha, 15).Text
TextBox16.Text = Plan1.Cells(Linha, 16).Value
TextBox17.Text = Plan1.Cells(Linha, 17).Value
TextBox18.Text = Plan1.Cells(Linha, 18).Value
TextBox34.Text = Plan1.Cells(Linha, 34).Text
TextBox36.Text = Plan1.Cells(Linha, 36).Text
TextBox37.Text = Plan1.Cells(Linha, 37).Text
TextBox38.Text = Plan1.Cells(Linha, 38).Text
TextBox39.Text = Plan1.Cells(Linha, 39).Text
TextBox40.Text = Plan1.Cells(Linha, 40).Text
TextBox41.Text = Plan1.Cells(Linha, 41).Text


End Sub


Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim Resultados As String

'Executa a busca
Set Busca = Plan1.Cells.Find(What:=TermoPesquisado, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)

'Caso tenha encontrado alguma ocorrência...
If Not Busca Is Nothing Then

Primeira_Ocorrencia = Busca.Address
Resultados = Busca.Row 'Lista o primeiro resultado na variavel

'Neste loop, pesquisa todas as próximas ocorrências para
'o termo pesquisado
Do
Set Busca = Plan1.Cells.FindNext(After:=Busca)

'Condicional para não listar o primeiro resultado
'pois já foi listado acima
If Not Busca.Address Like Primeira_Ocorrencia Then
Resultados = Resultados & ";" & Busca.Row
End If
Loop Until Busca.Address Like Primeira_Ocorrencia


MatrizResultados = Split(Resultados, ";")

'Atualiza dados iniciais no formulário
SpinButton1.Max = UBound(MatrizResultados) 'Valor maximo do seletor de registros

'habilita o seletor de registro
SpinButton1.Enabled = True

'indicador do seletor de registros
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultados) + 1


'Box com o conteudo encontrado
TextBox1.Text = Plan1.Cells(MatrizResultados(0), 1).Value
TextBox2.Text = Plan1.Cells(MatrizResultados(0), 2).Value
TextBox3.Text = Format(Plan1.Cells(MatrizResultados(0), 3).Value, "h:mm;@")
TextBox4.Text = Plan1.Cells(MatrizResultados(0), 4).Value
TextBox5.Text = Plan1.Cells(MatrizResultados(0), 5).Value
TextBox6.Text = Plan1.Cells(MatrizResultados(0), 6).Value
TextBox7.Text = Plan1.Cells(MatrizResultados(0), 7).Value
TextBox8.Text = Plan1.Cells(MatrizResultados(0), 8).Value
TextBox9.Text = Plan1.Cells(MatrizResultados(0), 9).Value
TextBox10.Text = Plan1.Cells(MatrizResultados(0), 10).Text
TextBox11.Text = Plan1.Cells(MatrizResultados(0), 11).Text
TextBox12.Text = Plan1.Cells(MatrizResultados(0), 12).Text
TextBox15.Text = Plan1.Cells(MatrizResultados(0), 15).Text
TextBox16.Text = Plan1.Cells(MatrizResultados(0), 16).Value
TextBox17.Text = Plan1.Cells(MatrizResultados(0), 17).Value
TextBox18.Text = Plan1.Cells(MatrizResultados(0), 18).Text
TextBox34.Text = Plan1.Cells(MatrizResultados(0), 34).Text
TextBox36.Text = Plan1.Cells(MatrizResultados(0), 36).Text
TextBox37.Text = Plan1.Cells(MatrizResultados(0), 37).Text
TextBox38.Text = Plan1.Cells(MatrizResultados(0), 38).Text
TextBox39.Text = Plan1.Cells(MatrizResultados(0), 39).Text
TextBox40.Text = Plan1.Cells(MatrizResultados(0), 40).Text
TextBox41.Text = Plan1.Cells(MatrizResultados(0), 41).Text

Else 'Caso nada tenha sido encontrado, exibe mensagem informativa

SpinButton1.Enabled = False 'desabilita o seletor de registros
Label_Registros_Contador.Caption = "" 'zera os resultados encontrados
'limpa os campos do formulário
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox15.Text = ""
TextBox16.Text = ""
TextBox17.Text = ""
TextBox18.Text = ""
TextBox34.Text = ""
TextBox36.Text = ""
TextBox37.Text = ""
TextBox38.Text = ""
TextBox39.Text = ""
TextBox40.Text = ""
TextBox41.Text = ""
MsgBox "Nenhuma Ocorrencia para '" & TermoPesquisado & "'encontrado."

End If

End Sub


Private Sub txt_Procurar_Change()

End Sub

Private Sub UserForm_Initialize()

SpinButton1.Enabled = False
Label_Registros_Contador.Caption = ""

End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Formulario de pesquisa

Mensagem por webmaster »

Colega,

Creio que substituindo este código:

Código: Selecionar todos

'Executa a busca
Set Busca = Plan1.Cells.Find(What:=TermoPesquisado, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Por este:

Código: Selecionar todos

'Executa a busca
Set Busca = Plan1.Range("A:D").Find(What:=TermoPesquisado, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Deve funcionar.

Abraços


wesantos
Acabou de chegar
Acabou de chegar
Mensagens: 7
Registrado em: Qui Jan 20, 2011 6:03 pm

Re: Formulario de pesquisa

Mensagem por wesantos »

Caro colega , obrigado pela ajuda porem não funcionou com este codigo. a pesquisa continua em toda a planilha.


Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Formulario de pesquisa

Mensagem por webmaster »

Colega,

Pode enviar a planilha para darmos uma olhada?

Abraços


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


wesantos
Acabou de chegar
Acabou de chegar
Mensagens: 7
Registrado em: Qui Jan 20, 2011 6:03 pm

Re: Formulario de pesquisa

Mensagem por wesantos »

Master obrigado pelo empenho em ajudar, resolvir mudar o projeto por completo utilizando um codigo disponibilizado no site Exceldoseujeito efetuando alguma adaptações a minha necessidade, inclusive recomendo a todos do forum, segue link da pagina; http://www.exceldoseujeito.com.br/2011/ ... /#more-458


Como sempre falta alguma coisa;
Tentei que o textbox na consulta me retorna-se a cor de preenchimento da celula com este codigo porem não deu certo sabes me dizer onde estou errando ?

With Me.TextBox3
.Value = Format(WorksheetFunction.Text(Plan1.Cells(linha, 3).Value 'retorna o valor da celula
.BackColor = Plan1.Cells(linha, 3).Interior.Color 'Retorna a cor de preenchimeto da celula
.ForeColor = Plan1.Cells(linha, 3).Font.Color 'Retorna a Cor da fonte da celula
End With


O codigo original e este, tentei anexar a planilha para facilitar não consegui devido o tamanho da mesma.

Public MatrizResultadosLinha As Variant
Public MatrizResultadosPlanilha As Variant
Public Total_Ocorrencias As Long
Public sCriterioDaBusca As String
Public sAcaoRequerida As String


Private Sub btn_Adicionar_Click()

'Definir a ação do comando
sAcaoRequerida = "Adicionar"

'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(True)


End Sub

Private Sub btn_Cancelar_Click()

'Definir a ação do comando
sAcaoRequerida = ""

'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(False)

'Recarrega os controles com os valores ativos na memória
Call SpinButton1_Change

txt_Procurar.Text = sCriterioDaBusca

End Sub

Private Sub btn_Editar_Click()

'Definir a ação do comando
sAcaoRequerida = "Editar"

'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(True)

End Sub

Private Sub btn_Excluir_Click()
Dim sLinha As Long
Dim iPlanilha As Integer

If MsgBox("Tem certeza que deseja eliminar este cadastro do sistema?", vbDefaultButton2 + vbQuestion + vbYesNo, Me.Caption) = vbYes Then
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)

'Exclui a linha do registro
Sheets(iPlanilha).Rows(sLinha).Delete

'Salva o arquivo
ThisWorkbook.Save

'Recarrega os registros para o formulário
txt_Procurar.Text = sCriterioDaBusca
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If

End Sub

Private Sub btn_Procurar_Click()

If txt_Procurar.Text = "" Then
MsgBox "Digite um valor para a pesquisa"
Else
sCriterioDaBusca = txt_Procurar.Text
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If

End Sub

Private Sub btn_Salvar_Click()
Dim sLinha As Long
Dim iPlanilha As Integer

'Realiza a ação apropriada
Select Case sAcaoRequerida
Case "Adicionar"
With Sheets(Combo_OndeSalvar.Text)
sLinha = .Range("A:A").SpecialCells(xlLastCell).Row + 1 'Pega a próxima linha vazia para cadastrar novo
'Grava os novos valores informados no formulário para a planilha base de dados
.Cells(sLinha, 1).Value = TextBox1.Text
.Cells(sLinha, 2).Value = TextBox2.Text
.Cells(sLinha, 3).Value = TextBox3.Text
.Cells(sLinha, 4).Value = TextBox4.Text
.Cells(sLinha, 5).Value = TextBox5.Text
.Cells(sLinha, 6).Value = TextBox6.Text
.Cells(sLinha, 7).Value = TextBox7.Text
.Cells(sLinha, 8).Value = TextBox8.Text
.Cells(sLinha, 9).Value = TextBox9.Text
.Cells(sLinha, 10).Value = TextBox10.Text
.Cells(sLinha, 11).Value = TextBox11.Text
.Cells(sLinha, 12).Value = TextBox12.Text
.Cells(sLinha, 16).Value = TextBox16.Text
.Cells(sLinha, 18).Value = TextBox18.Text
.Cells(sLinha, 34).Value = TextBox34.Text
.Cells(sLinha, 35).Value = TextBox35.Text
.Cells(sLinha, 36).Value = TextBox36.Text
.Cells(sLinha, 37).Value = TextBox37.Text
.Cells(sLinha, 38).Value = TextBox38.Text
.Cells(sLinha, 39).Value = TextBox39.Text
.Cells(sLinha, 40).Value = TextBox40.Text
.Cells(sLinha, 41).Value = TextBox41.Text

End With
Case "Editar"
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)

With Sheets(iPlanilha)
'Atualiza os dados na linha de registro específica
.Cells(sLinha, 1).Value = TextBox1.Text
.Cells(sLinha, 2).Value = TextBox2.Text
.Cells(sLinha, 3).Value = TextBox3.Text
.Cells(sLinha, 4).Value = TextBox4.Text
.Cells(sLinha, 5).Value = TextBox5.Text
.Cells(sLinha, 6).Value = TextBox6.Text
.Cells(sLinha, 7).Value = TextBox7.Text
.Cells(sLinha, 8).Value = TextBox8.Text
.Cells(sLinha, 9).Value = TextBox9.Text
.Cells(sLinha, 10).Value = TextBox10.Text
.Cells(sLinha, 11).Value = TextBox11.Text
.Cells(sLinha, 12).Value = TextBox12.Text
.Cells(sLinha, 16).Value = TextBox16.Text
.Cells(sLinha, 18).Value = TextBox18.Text
.Cells(sLinha, 34).Value = TextBox34.Text
.Cells(sLinha, 35).Value = TextBox35.Text
.Cells(sLinha, 36).Value = TextBox36.Text
.Cells(sLinha, 37).Value = TextBox37.Text
.Cells(sLinha, 38).Value = TextBox38.Text
.Cells(sLinha, 39).Value = TextBox39.Text
.Cells(sLinha, 40).Value = TextBox40.Text
.Cells(sLinha, 41).Value = TextBox41.Text

End With
Case Else
Exit Sub
End Select

'Definir a ação do comando
sAcaoRequerida = ""

'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(False)

'Recarrega os valores da pesquisa para exibir no formulário
If sCriterioDaBusca <> "" Then
txt_Procurar.Text = sCriterioDaBusca
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If

'Salva o arquivo
ThisWorkbook.Save

End Sub

Private Sub SpinButton1_Change()
Dim sLinha As Long
Dim iPlanilha As Integer
Dim TotalOcorrencias As Long

If IsArray(MatrizResultadosLinha) Then 'Verifica se há informações de busca na matriz de resultados
'Se houver dados retornados da busca, então carrega no formulário
TotalOcorrencias = SpinButton1.Max + 1
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)

Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias

With Sheets(iPlanilha)
Label_PlanBase.Caption = "Em " & .Name
TextBox1.Text = .Cells(sLinha, 1).Value
TextBox2.Text = .Cells(sLinha, 2).Value
TextBox3.Text = .Cells(sLinha, 3).Text
TextBox4.Text = .Cells(sLinha, 4).Value
TextBox5.Text = .Cells(sLinha, 5).Value
TextBox6.Text = .Cells(sLinha, 6).Value
TextBox7.Text = .Cells(sLinha, 7).Value
TextBox8.Text = .Cells(sLinha, 8).Value
TextBox9.Text = .Cells(sLinha, 9).Value
TextBox10.Text = .Cells(sLinha, 10).Text
TextBox11.Text = .Cells(sLinha, 11).Text
TextBox12.Text = .Cells(sLinha, 12).Text
TextBox16.Text = .Cells(sLinha, 16).Text
TextBox18.Text = .Cells(sLinha, 18).Text
TextBox34.Text = .Cells(sLinha, 34).Text
TextBox35.Text = .Cells(sLinha, 35).Text
TextBox36.Text = .Cells(sLinha, 36).Text
TextBox37.Text = .Cells(sLinha, 37).Text
TextBox38.Text = .Cells(sLinha, 38).Text
TextBox39.Text = .Cells(sLinha, 39).Text
TextBox40.Text = .Cells(sLinha, 40).Text
TextBox41.Text = .Cells(sLinha, 41).Text
End With
End If

End Sub


Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String, ByVal sPesquisarNoCampo As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim ResultadosLinha As String
Dim ResultadosPlanilha As String
Dim sSearchInCol As String
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer

'Define a Coluna onde a informação será pesquisada
sSearchInCol = ConfigColunas(sPesquisarNoCampo)

'Define as Planilhas onde a informação será pesquisada
arrPesquisarNasPlanilhas = ConfigPlanilhasBase

'Inicializa os resultados
ResultadosLinha = ""
ResultadosPlanilha = ""
MatrizResultadosLinha = ""
MatrizResultadosPlanilha = ""

'Executa a busca

For i = 0 To UBound(arrPesquisarNasPlanilhas)
With Sheets(arrPesquisarNasPlanilhas(i))
If sSearchInCol = "" Then
Set Busca = .Cells.Find(What:=TermoPesquisado, After:=.Range("A4"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).Find( _
What:=TermoPesquisado, _
After:=.Range(sSearchInCol & "1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If

'Caso tenha encontrado alguma ocorrência...
If Not Busca Is Nothing Then

Primeira_Ocorrencia = Busca.Address
ResultadosLinha = ResultadosLinha & IIf((Len(ResultadosLinha) > 0), ";", "") & Busca.Row 'Lista o primeiro resultado na variavel - linha da ocorrência
ResultadosPlanilha = ResultadosPlanilha & IIf((Len(ResultadosPlanilha) > 0), ";", "") & .Index 'Lista o primeiro resultado na variavel - planilha da ocorrência

'Neste loop, pesquisa todas as próximas ocorrências para
'o termo pesquisado
Do
If sSearchInCol = "" Then
Set Busca = .Cells.FindNext(After:=Busca)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).FindNext(After:=Busca)
End If

'Condicional para não listar o primeiro resultado
'pois já foi listado acima
If Not Busca.Address Like Primeira_Ocorrencia Then
ResultadosLinha = ResultadosLinha & ";" & Busca.Row
ResultadosPlanilha = ResultadosPlanilha & ";" & .Index
End If
Loop Until Busca.Address Like Primeira_Ocorrencia

End If
End With
Next i


If Len(ResultadosLinha) > 0 Then 'Se foram encontrados resultados
MatrizResultadosLinha = Split(ResultadosLinha, ";")
MatrizResultadosPlanilha = Split(ResultadosPlanilha, ";")

'Atualiza dados iniciais no formulário
SpinButton1.Max = UBound(MatrizResultadosLinha) 'Valor maximo do seletor de registros

'habilita o seletor de registro
SpinButton1.Enabled = True

'indicador do seletor de registros
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultadosLinha) + 1


'Box com o conteudo encontrado
With Sheets(CInt(MatrizResultadosPlanilha(0)))
Label_PlanBase.Caption = "Em " & .Name
TextBox1.Text = .Cells(MatrizResultadosLinha(0), 1).Value
TextBox2.Text = .Cells(MatrizResultadosLinha(0), 2).Value
TextBox3.Text = .Cells(MatrizResultadosLinha(0), 3).Text
TextBox4.Text = .Cells(MatrizResultadosLinha(0), 4).Value
TextBox5.Text = .Cells(MatrizResultadosLinha(0), 5).Value
TextBox6.Text = .Cells(MatrizResultadosLinha(0), 6).Value
TextBox7.Text = .Cells(MatrizResultadosLinha(0), 7).Value
TextBox8.Text = .Cells(MatrizResultadosLinha(0), 8).Value
TextBox9.Text = .Cells(MatrizResultadosLinha(0), 9).Value
TextBox10.Text = .Cells(MatrizResultadosLinha(0), 10).Text
TextBox11.Text = .Cells(MatrizResultadosLinha(0), 11).Text
TextBox12.Text = .Cells(MatrizResultadosLinha(0), 12).Text
TextBox16.Text = .Cells(MatrizResultadosLinha(0), 16).Text
TextBox18.Text = .Cells(MatrizResultadosLinha(0), 18).Text
TextBox34.Text = .Cells(MatrizResultadosLinha(0), 34).Text
TextBox35.Text = .Cells(MatrizResultadosLinha(0), 35).Text
TextBox36.Text = .Cells(MatrizResultadosLinha(0), 36).Text
TextBox37.Text = .Cells(MatrizResultadosLinha(0), 37).Text
TextBox38.Text = .Cells(MatrizResultadosLinha(0), 38).Text
TextBox39.Text = .Cells(MatrizResultadosLinha(0), 39).Text
TextBox40.Text = .Cells(MatrizResultadosLinha(0), 40).Text
TextBox41.Text = .Cells(MatrizResultadosLinha(0), 41).Text
End With

btn_Editar.Enabled = True
btn_Excluir.Enabled = True

Else 'Caso nada tenha sido encontrado, exibe mensagem informativa

SpinButton1.Enabled = False 'desabilita o seletor de registros
btn_Editar.Enabled = False
btn_Excluir.Enabled = False
Label_Registros_Contador.Caption = "" 'zera os resultados encontrados
Label_PlanBase.Caption = ""
'limpa os campos do formulário
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox16.Text = ""
TextBox18.Text = ""
TextBox34.Text = ""
TextBox35.Text = ""
TextBox36.Text = ""
TextBox37.Text = ""
TextBox38.Text = ""
TextBox39.Text = ""
TextBox40.Text = ""
TextBox41.Text = ""
MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."

End If

End Sub

Private Sub TextBox11_Change()

End Sub

Private Sub TextBox40_Change()

End Sub

Private Sub UserForm_Initialize()

SpinButton1.Enabled = False
btn_Editar.Enabled = False
btn_Excluir.Enabled = False
Combo_OndeSalvar.Visible = False
Label_OndeSalvar.Visible = False
Label_Registros_Contador.Caption = ""
Call ConfigurarListaDeCampos

End Sub

Sub ConfigurarListaDeCampos()
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer

With ComboBox1
.Style = fmStyleDropDownList

.AddItem "Tudo" '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
.AddItem "Nota"
.AddItem "Fabricante"
.AddItem "Pedido"
.AddItem "Produto"
.AddItem "Destino Final"

.ListIndex = 0
End With

With Combo_OndeSalvar
'Recupera as Planilhas que são base de dados
arrPesquisarNasPlanilhas = ConfigPlanilhasBase

.Style = fmStyleDropDownList

For i = 0 To UBound(arrPesquisarNasPlanilhas)
.AddItem arrPesquisarNasPlanilhas(i)
Next i

.ListIndex = 0
End With



End Sub

Function ConfigColunas(ByVal sNomeCampo As String) As String

Select Case sNomeCampo
Case "Nota"
ConfigColunas = "A"
Case "Fabricante"
ConfigColunas = "D"
Case "Pedido"
ConfigColunas = "G"
Case "Produto"
ConfigColunas = "I"
Case "Destino Final"
ConfigColunas = "F"
Case Else '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
ConfigColunas = ""
End Select

End Function

Function ConfigPlanilhasBase() As Variant
Dim sNomeDasPlanilhas As String

'Digite o nome das Planilhasonde os dados deverão ser procurados,
'separados por ponto-e-vírgula (;)
'
sNomeDasPlanilhas = "Agendamentos" '<----- Informe as planilhas aqui


Do While (Right(sNomeDasPlanilhas, 1) = ";")
sNomeDasPlanilhas = Left(sNomeDasPlanilhas, Len(sNomeDasPlanilhas) - 1)
Loop

ConfigPlanilhasBase = Split(sNomeDasPlanilhas, ";")

End Function

Sub HabilitarControlesParaEdicao(ByVal bOpcao As Boolean)

'Habilitar Botões Salvar/Cancelar
btn_Salvar.Visible = bOpcao
btn_Cancelar.Visible = bOpcao
btn_Adicionar.Visible = Not (bOpcao)
btn_Editar.Visible = Not (bOpcao)
btn_Excluir.Visible = Not (bOpcao)

btn_Procurar.Enabled = Not (bOpcao)
txt_Procurar.Enabled = Not (bOpcao)
ComboBox1.Enabled = Not (bOpcao)
txt_Procurar.Value = ""
Label_Registros_Contador.Caption = ""
Label_PlanBase.Caption = ""

If bOpcao = False And IsArray(MatrizResultadosLinha) Then
SpinButton1.Enabled = True
Else
SpinButton1.Enabled = False
End If

'Liberar Campos para Edição.
TextBox1.Locked = Not (bOpcao)
TextBox2.Locked = Not (bOpcao)
TextBox3.Locked = Not (bOpcao)
TextBox4.Locked = Not (bOpcao)
TextBox5.Locked = Not (bOpcao)
TextBox6.Locked = Not (bOpcao)

'Limpar o conteúdo dos campos
If sAcaoRequerida <> "Editar" Then
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""

Combo_OndeSalvar.Visible = bOpcao
Label_OndeSalvar.Visible = bOpcao
End If

If bOpcao = True Then
TextBox1.SetFocus
End If


End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder