Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Erro em tempo de ex...
 
Notifications
Clear all

Erro em tempo de execução

 
2024 - VBA & Macros
7 Posts
2 Usuários
0 Reactions
1,642 Visualizações
RSS
 tecin
(@tecin)
Posts: 3
New Member
Topic starter
 

Boa tarde a todos, sou novo aqui e não tenho muitos conhecimentos em excel, temos uma planilha que tem macros e vba.
Minha maquina foi formatada e agora quando vou abrir a planilha ela gera o seguinte erro...
ERRO EM TEMPO DE EXECUÇÃO
O OBJETO É OBRIGATORIO.
FIM DEPURAR AJUDA
Quando clico em depurar é aberto o VISUAL BASIC APLICATIONS e com a seguinte linha em amarelo frmBusca.Show
Alguém poderia me ajudar?
Grato!

 
Postado : 15/08/2017 11:52 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia tecin,

O erro não está exatamente nessa linha de código.
Acredito estar na Initialize ou no Activate do formulário.
Teria que ver esses códigos para identificar o erro.

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/08/2017 5:46 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia tecin,

O erro não está exatamente nessa linha de código.
Acredito estar na Initialize ou no Activate do formulário.
Teria que ver esses códigos para identificar o erro.

Qualquer coisa da o grito.
Abraço

Geralmente é mostrada esta linha quando o formulário é iniciado e em determinado ponto da rotina é encontrado algum controle inexistente, então volta para o inicio que é a chamada do formulario, e é como o Bernardo disse, teria de ver o código completo, mas como diz que o excel foi reinstalado, e se seu formulário tem o controle "LISTVIEW" eu arrisco dizer que é devido a ele.
Verifique também na janela do Vba no Menu "Ferramentas / Referências ...." se tem alguma opção dizendo "AUSENTE", se sim desabilite e tente novamente.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/08/2017 8:11 am
 tecin
(@tecin)
Posts: 3
New Member
Topic starter
 

Quando vou clicar em CADASTRO DE PROPRIETARIO que da esse erro.
Segue o codigo....

Private Sub cmdCadastrarProprietário_Click()

'Worksheets("cadastros").Visible = True

frmBusca.Show

Unload Me

End Sub

Private Sub cmdMapa_Click()

Worksheets("Lotes").Activate

ColorirMapa

Unload Me

End Sub

Private Sub cmdVisualizarStatus_Click()

'Worksheets("ORIGINAL").Visible = True
Worksheets("ORIGINAL").Activate

Unload Me

End Sub

Private Sub cmdVisualizarStatus_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

End Sub

Private Sub cmdVisualizarStatus_Error(ByVal Number As Integer, ByVal Description As MSForms.ReturnString, ByVal SCode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, ByVal CancelDisplay As MSForms.ReturnBoolean)

End Sub

Private Sub UserForm_Click()

End Sub

 
Postado : 16/08/2017 10:25 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Tecin, o melhor seria você anexar o seu modelo, senão vamos ficar em suposições.
O código que nos referimos é o que se está no frmBusca, a rotina que postou só está pedindo para abrir o mesmo, então ao abrir deve ter instruções no procedimento do formulário em : "Private Sub UserForm_Initialize()".
Mas antes de postar, você verificou o que eu disse acima ? O frmBusca tem o controle LISTVIEW ? Verificou as referencias se tem alguma AUSENTE ?
Uma opção seria você seguir a rotina passo a passo utilizando a tecla F8, assim terá certeza em qual linha está ocorrendo o erro.
Qual versão do excel está utilizando ?

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/08/2017 11:34 am
 tecin
(@tecin)
Posts: 3
New Member
Topic starter
 

Desculpa gente, mas esse negócio para mim é grego, o cara que desenvolveu nem existe mais eu acho.
A versão do Office é 2016, em outra maquina também com o 2016 roda normal, mas na minha gera esse erro depois da formatação.
Tinha realmente um Ausente e desabilitei ele, mas o erro persiste.

Segue o codigo do frmBusca...

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()
    
'On Error GoTo aviso 'tendo erros, pula para aviso
    
    'Definir a ação do comando
    sAcaoRequerida = "Adicionar"
    
    'Habilitar Botões Salvar/Cancelar
    Call HabilitarControlesParaEdicao(True)
    
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Sub

Private Sub btn_Cancelar_Click()
    
'On Error GoTo aviso 'tendo erros, pula para aviso
    
    '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
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
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

'On Error GoTo aviso 'tendo erros, pula para aviso

    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
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Sub

Private Sub btn_Procurar_Click()

'On Error GoTo aviso 'tendo erros, pula para aviso

    If txt_Procurar.Text = "" Then
        MsgBox "Digite um valor para a pesquisa"
    Else
        sCriterioDaBusca = txt_Procurar.Text
        Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
    End If
    
'aviso:
   ' MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Sub

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

'On Error GoTo aviso 'tendo erros, pula para aviso

    'Realiza a ação apropriada
    Select Case sAcaoRequerida
        Case "Adicionar"
            With Sheets(Combo_OndeSalvar.Text)
                sLinha = .Range("A1").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, 13).Value = TextBox13.Text
                .Cells(sLinha, 14).Value = TextBox14.Text
                .Cells(sLinha, 15).Value = TextBox15.Text
                .Cells(sLinha, 16).Value = TextBox16.Text
                .Cells(sLinha, 17).Value = TextBox17.Text
                .Cells(sLinha, 18).Value = TextBox18.Text
                .Cells(sLinha, 19).Value = TextBox19.Text
                .Cells(sLinha, 20).Value = TextBox20.Text
                .Cells(sLinha, 21).Value = TextBox21.Text
                .Cells(sLinha, 22).Value = TextBox22.Text
                .Cells(sLinha, 23).Value = TextBox23.Text
                .Cells(sLinha, 24).Value = TextBox24.Text
                .Cells(sLinha, 25).Value = TextBox25.Text
                .Cells(sLinha, 26).Value = TextBox26.Text
                .Cells(sLinha, 27).Value = TextBox27.Text
                .Cells(sLinha, 28).Value = TextBox28.Text
                .Cells(sLinha, 29).Value = TextBox29.Text
                .Cells(sLinha, 30).Value = TextBox30.Text
                .Cells(sLinha, 31).Value = TextBox31.Text
                .Cells(sLinha, 32).Value = TextBox32.Text
                .Cells(sLinha, 33).Value = TextBox33.Text
                .Cells(sLinha, 34).Value = TextBox34.Text
                .Cells(sLinha, 35).Value = TextBox35.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, 13).Value = TextBox13.Text
                .Cells(sLinha, 14).Value = TextBox14.Text
                .Cells(sLinha, 15).Value = TextBox15.Text
                .Cells(sLinha, 16).Value = TextBox16.Text
                .Cells(sLinha, 17).Value = TextBox17.Text
                .Cells(sLinha, 18).Value = TextBox18.Text
                .Cells(sLinha, 19).Value = TextBox19.Text
                .Cells(sLinha, 20).Value = TextBox20.Text
                .Cells(sLinha, 21).Value = TextBox21.Text
                .Cells(sLinha, 22).Value = TextBox22.Text
                .Cells(sLinha, 23).Value = TextBox23.Text
                .Cells(sLinha, 24).Value = TextBox24.Text
                .Cells(sLinha, 25).Value = TextBox25.Text
                .Cells(sLinha, 26).Value = TextBox26.Text
                .Cells(sLinha, 27).Value = TextBox27.Text
                .Cells(sLinha, 28).Value = TextBox28.Text
                .Cells(sLinha, 29).Value = TextBox29.Text
                .Cells(sLinha, 30).Value = TextBox30.Text
                .Cells(sLinha, 31).Value = TextBox31.Text
                .Cells(sLinha, 32).Value = TextBox32.Text
                .Cells(sLinha, 33).Value = TextBox33.Text
                .Cells(sLinha, 34).Value = TextBox34.Text
                .Cells(sLinha, 35).Value = TextBox35.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
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Sub

Private Sub cmdSair_Click()
    Unload Me
End Sub


Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)
    Cancel = True
End Sub

'Use este evento do Listview para carregar os dados selecionados nas caixas de texto
'Tem a mesma função que o SpinButton tinha na versão anterior
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim sLinha As Long
Dim iPlanilha As Integer
Dim TotalOcorrencias As Long

'On Error GoTo aviso 'tendo erros, pula para aviso

    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 = ListView1.ListItems.Count
        sLinha = MatrizResultadosLinha(Item)
        iPlanilha = MatrizResultadosPlanilha(Item)
        
        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).Value
            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).Value
            TextBox11.Text = .Cells(sLinha, 11).Value
            TextBox12.Text = .Cells(sLinha, 12).Value
            TextBox13.Text = .Cells(sLinha, 13).Value
            TextBox14.Text = .Cells(sLinha, 14).Value
            TextBox15.Text = .Cells(sLinha, 15).Value
            TextBox16.Text = .Cells(sLinha, 16).Value
            TextBox17.Text = .Cells(sLinha, 17).Value
            TextBox18.Text = .Cells(sLinha, 18).Value
            TextBox19.Text = .Cells(sLinha, 19).Value
            TextBox20.Text = .Cells(sLinha, 20).Value
            TextBox21.Text = .Cells(sLinha, 21).Value
            TextBox22.Text = .Cells(sLinha, 22).Value
            TextBox23.Text = .Cells(sLinha, 23).Value
            TextBox24.Text = .Cells(sLinha, 24).Value
            TextBox25.Text = .Cells(sLinha, 25).Value
            TextBox26.Text = .Cells(sLinha, 26).Value
            TextBox27.Text = .Cells(sLinha, 27).Value
            TextBox28.Text = .Cells(sLinha, 28).Value
            TextBox29.Text = .Cells(sLinha, 29).Value
            TextBox30.Text = .Cells(sLinha, 30).Value
            TextBox31.Text = .Cells(sLinha, 31).Value
            TextBox32.Text = .Cells(sLinha, 32).Value
            TextBox33.Text = .Cells(sLinha, 33).Value
            TextBox34.Text = .Cells(sLinha, 34).Value
            TextBox35.Text = .Cells(sLinha, 35).Value



        End With
    End If
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Sub

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

'On Error GoTo aviso 'tendo erros, pula para aviso

    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).Value
            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).Value
            TextBox11.Text = .Cells(sLinha, 11).Value
            TextBox12.Text = .Cells(sLinha, 12).Value
            TextBox13.Text = .Cells(sLinha, 13).Value
            TextBox14.Text = .Cells(sLinha, 14).Value
            TextBox15.Text = .Cells(sLinha, 15).Value
            TextBox16.Text = .Cells(sLinha, 16).Value
            TextBox17.Text = .Cells(sLinha, 17).Value
            TextBox18.Text = .Cells(sLinha, 18).Value
            TextBox19.Text = .Cells(sLinha, 19).Value
            TextBox20.Text = .Cells(sLinha, 20).Value
            TextBox21.Text = .Cells(sLinha, 21).Value
            TextBox22.Text = .Cells(sLinha, 22).Value
            TextBox23.Text = .Cells(sLinha, 23).Value
            TextBox24.Text = .Cells(sLinha, 24).Value
            TextBox25.Text = .Cells(sLinha, 25).Value
            TextBox26.Text = .Cells(sLinha, 26).Value
            TextBox27.Text = .Cells(sLinha, 27).Value
            TextBox28.Text = .Cells(sLinha, 28).Value
            TextBox29.Text = .Cells(sLinha, 29).Value
            TextBox30.Text = .Cells(sLinha, 30).Value
            TextBox31.Text = .Cells(sLinha, 31).Value
            TextBox32.Text = .Cells(sLinha, 32).Value
            TextBox33.Text = .Cells(sLinha, 33).Value
            TextBox34.Text = .Cells(sLinha, 34).Value
            TextBox35.Text = .Cells(sLinha, 35).Value

        End With
    End If
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
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

'On Error GoTo aviso 'tendo erros, pula para aviso

    '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("A1"), 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
        
        Call PreencheListView
        
        '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).Value
            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).Value
            TextBox11.Text = .Cells(MatrizResultadosLinha(0), 11).Value
            TextBox12.Text = .Cells(MatrizResultadosLinha(0), 12).Value
            TextBox13.Text = .Cells(MatrizResultadosLinha(0), 13).Value
            TextBox14.Text = .Cells(MatrizResultadosLinha(0), 14).Value
            TextBox15.Text = .Cells(MatrizResultadosLinha(0), 15).Value
            TextBox16.Text = .Cells(MatrizResultadosLinha(0), 16).Value
            TextBox17.Text = .Cells(MatrizResultadosLinha(0), 17).Value
            TextBox18.Text = .Cells(MatrizResultadosLinha(0), 18).Value
            TextBox19.Text = .Cells(MatrizResultadosLinha(0), 19).Value
            TextBox20.Text = .Cells(MatrizResultadosLinha(0), 20).Value
            TextBox21.Text = .Cells(MatrizResultadosLinha(0), 21).Value
            TextBox22.Text = .Cells(MatrizResultadosLinha(0), 22).Value
            TextBox23.Text = .Cells(MatrizResultadosLinha(0), 23).Value
            TextBox24.Text = .Cells(MatrizResultadosLinha(0), 24).Value
            TextBox25.Text = .Cells(MatrizResultadosLinha(0), 25).Value
            TextBox26.Text = .Cells(MatrizResultadosLinha(0), 26).Value
            TextBox27.Text = .Cells(MatrizResultadosLinha(0), 27).Value
            TextBox28.Text = .Cells(MatrizResultadosLinha(0), 28).Value
            TextBox29.Text = .Cells(MatrizResultadosLinha(0), 29).Value
            TextBox30.Text = .Cells(MatrizResultadosLinha(0), 30).Value
            TextBox31.Text = .Cells(MatrizResultadosLinha(0), 31).Value
            TextBox32.Text = .Cells(MatrizResultadosLinha(0), 32).Value
            TextBox33.Text = .Cells(MatrizResultadosLinha(0), 33).Value
            TextBox34.Text = .Cells(MatrizResultadosLinha(0), 34).Value
            TextBox35.Text = .Cells(MatrizResultadosLinha(0), 35).Value
            
        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.Value = ""
        TextBox6.Value = ""
        TextBox7.Value = ""
        TextBox8.Value = ""
        TextBox9.Value = ""
        TextBox10.Value = ""
        TextBox11.Value = ""
        TextBox12.Value = ""
        TextBox13.Value = ""
        TextBox14.Value = ""
        TextBox15.Value = ""
        TextBox16.Value = ""
        TextBox17.Value = ""
        TextBox18.Value = ""
        TextBox19.Value = ""
        TextBox20.Value = ""
        TextBox21.Value = ""
        TextBox22.Value = ""
        TextBox23.Value = ""
        TextBox24.Value = ""
        TextBox25.Value = ""
        TextBox26.Value = ""
        TextBox27.Value = ""
        TextBox28.Value = ""
        TextBox29.Value = ""
        TextBox30.Value = ""
        TextBox31.Value = ""
        TextBox32.Value = ""
        TextBox33.Value = ""
        TextBox34.Value = ""
        TextBox35.Value = ""
        MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."
    
    End If
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Sub



Private Sub UserForm_Initialize()

'inicializa maximizado
    With Application

        .WindowState = xlMaximized

        Zoom = Int(.Width / Me.Width * 100)

        Width = .Width

        Height = .Height

    End With



    Worksheets("cadastros").Visible = True
    Worksheets("cadastros").Activate

    SpinButton1.Enabled = False
    btn_Editar.Enabled = False
    btn_Excluir.Enabled = False
    'cmdSair.Enabled = False
    
    Combo_OndeSalvar.Visible = False
    Label_OndeSalvar.Visible = False
    Label_Registros_Contador.Caption = ""
    Call ConfigurarListaDeCampos
    Call ConfigListView
    
    
End Sub

'AJUSTAR ESSA ROTINA
Sub ConfigListView()

'On Error GoTo aviso 'tendo erros, pula para aviso

    With ListView1
        'CAMPOS DE CADASTRO DE PESSOA JURIDICA
        .ColumnHeaders.Add 1, "razao_social", "Razao Social", 0
        .ColumnHeaders.Add 2, "nome_fantasia", "Nome Fantasia", 90
        .ColumnHeaders.Add 3, "cnpj", "CNPJ", 40
        .ColumnHeaders.Add 4, "endereco_Sede", "Endereco da Sede", 50
        .ColumnHeaders.Add 5, "bairro_juridico", "Bairro", 50
        
        .ColumnHeaders.Add 6, "cidade_juridico", "Cidade", 50
        .ColumnHeaders.Add 7, "estado_juridico", "Estado", 50
        .ColumnHeaders.Add 8, "cep_juridico", "CEP EMPRESA", 50
        .ColumnHeaders.Add 9, "rg_juridico", "RG", 50
        .ColumnHeaders.Add 10, "telefone_juridico", "Telefone", 50
        .ColumnHeaders.Add 11, "fax_juridico", "FAX", 50
        .ColumnHeaders.Add 12, "email_juridico", "E-mail", 50
        .ColumnHeaders.Add 13, "site_juridico", "Site", 50
        
        'CAMPOS DE CADASTROS DE PESSOA FISICA
        .ColumnHeaders.Add 14, "nome_completo", "Nome Completo", 50
        .ColumnHeaders.Add 15, "data_Nascimento", "Data Nascimento", 50
        .ColumnHeaders.Add 16, "filiacao", "Filiacao", 50
        .ColumnHeaders.Add 17, "nacionalidade", "Nacionalidade", 50
        .ColumnHeaders.Add 18, "naturalidade", "Naturalidade", 50
        .ColumnHeaders.Add 19, "uf", "UF", 50
        .ColumnHeaders.Add 20, "estado_civil", "Estado Civil", 50
        .ColumnHeaders.Add 21, "regime_casamento", "Regime Casamento", 50
        .ColumnHeaders.Add 22, "dependentes", "Dependentes", 50
        .ColumnHeaders.Add 23, "cpf", "CPF", 50
        .ColumnHeaders.Add 24, "identidade", "Identidade", 50
        .ColumnHeaders.Add 25, "expeditor", "Orgao Expeditor", 50
        .ColumnHeaders.Add 26, "data_emissao", "Data Emissao", 50
        .ColumnHeaders.Add 27, "telefone_residencial", "Telefone Residencial", 50
        .ColumnHeaders.Add 28, "telefone_celular", "Telefone Residencial", 50
        .ColumnHeaders.Add 29, "email", "E-mail", 50
        .ColumnHeaders.Add 30, "residencia_atual", "Residencia Atual", 50
        .ColumnHeaders.Add 31, "numero", "Numero", 50
        .ColumnHeaders.Add 32, "bairro", "Bairro", 50
        .ColumnHeaders.Add 33, "cidade", "Cidade", 50
        .ColumnHeaders.Add 34, "uf_fisico", "UF", 50
        .ColumnHeaders.Add 35, "cep_fisico", "CEP", 50

        
        .Gridlines = True
        .FullRowSelect = True
        .HideColumnHeaders = False
        .View = lvwReport
    End With
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"

End Sub

Sub PreencheListView()
Dim i As Long

'On Error GoTo Erro 'tendo erros, pula para aviso

    ListView1.ListItems.Clear
    
    If IsArray(MatrizResultadosLinha) Then
        For i = 0 To UBound(MatrizResultadosLinha)
            Set NewItem = ListView1.ListItems.Add(, , i)
            
            With Sheets(CInt(MatrizResultadosPlanilha(i)))
                NewItem.SubItems(1) = .Cells(MatrizResultadosLinha(i), 1).Value
                NewItem.SubItems(2) = .Cells(MatrizResultadosLinha(i), 2).Value
                NewItem.SubItems(3) = .Cells(MatrizResultadosLinha(i), 3).Value
                NewItem.SubItems(4) = .Cells(MatrizResultadosLinha(i), 4).Value
                NewItem.SubItems(5) = .Cells(MatrizResultadosLinha(i), 5).Value
                NewItem.SubItems(6) = .Cells(MatrizResultadosLinha(i), 6).Value
                NewItem.SubItems(7) = .Cells(MatrizResultadosLinha(i), 7).Value
                NewItem.SubItems(8) = .Cells(MatrizResultadosLinha(i), 8).Value
                NewItem.SubItems(9) = .Cells(MatrizResultadosLinha(i), 9).Value
                NewItem.SubItems(10) = .Cells(MatrizResultadosLinha(i), 10).Value
                
                NewItem.SubItems(11) = .Cells(MatrizResultadosLinha(i), 11).Value
                NewItem.SubItems(12) = .Cells(MatrizResultadosLinha(i), 12).Value
                NewItem.SubItems(13) = .Cells(MatrizResultadosLinha(i), 13).Value
                NewItem.SubItems(14) = .Cells(MatrizResultadosLinha(i), 14).Value
                NewItem.SubItems(15) = .Cells(MatrizResultadosLinha(i), 15).Value
                NewItem.SubItems(16) = .Cells(MatrizResultadosLinha(i), 16).Value
                NewItem.SubItems(17) = .Cells(MatrizResultadosLinha(i), 17).Value
                NewItem.SubItems(18) = .Cells(MatrizResultadosLinha(i), 18).Value
                NewItem.SubItems(19) = .Cells(MatrizResultadosLinha(i), 19).Value
                NewItem.SubItems(20) = .Cells(MatrizResultadosLinha(i), 20).Value
                NewItem.SubItems(21) = .Cells(MatrizResultadosLinha(i), 21).Value
                NewItem.SubItems(22) = .Cells(MatrizResultadosLinha(i), 22).Value
                NewItem.SubItems(23) = .Cells(MatrizResultadosLinha(i), 23).Value
                NewItem.SubItems(24) = .Cells(MatrizResultadosLinha(i), 24).Value
                NewItem.SubItems(25) = .Cells(MatrizResultadosLinha(i), 25).Value
                NewItem.SubItems(26) = .Cells(MatrizResultadosLinha(i), 26).Value
                NewItem.SubItems(27) = .Cells(MatrizResultadosLinha(i), 27).Value
                NewItem.SubItems(28) = .Cells(MatrizResultadosLinha(i), 28).Value
                NewItem.SubItems(29) = .Cells(MatrizResultadosLinha(i), 29).Value
                NewItem.SubItems(30) = .Cells(MatrizResultadosLinha(i), 30).Value
                NewItem.SubItems(31) = .Cells(MatrizResultadosLinha(i), 31).Value
                NewItem.SubItems(32) = .Cells(MatrizResultadosLinha(i), 32).Value
                NewItem.SubItems(33) = .Cells(MatrizResultadosLinha(i), 33).Value
                NewItem.SubItems(34) = .Cells(MatrizResultadosLinha(i), 34).Value
'                NewItem.SubItems(35) = .Cells(MatrizResultadosLinha(i), 35).Value

            End With
        Next i
    End If
    
'Erro:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Sub

Sub ConfigurarListaDeCampos()
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
    
'On Error GoTo aviso 'tendo erros, pula para aviso
    
    With ComboBox1
        .Style = fmStyleDropDownList
        
        .AddItem "Tudo"     '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
        .AddItem "Razão Social"
        .AddItem "CNPJ"
        .AddItem "Nome Completo"
        .AddItem "CPF"
        
        .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
    
'aviso:
   ' MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"

End Sub

Function ConfigColunas(ByVal sNomeCampo As String) As String

'On Error GoTo aviso 'tendo erros, pula para aviso

    Select Case sNomeCampo
        Case "Razão Social"
            ConfigColunas = "A"
        Case "CNPJ"
            ConfigColunas = "C"
        Case "Nome Completo"
            ConfigColunas = "N"
        Case "CPF"
            ConfigColunas = "W"
        Case Else           '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
            ConfigColunas = ""
    End Select
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Function

Function ConfigPlanilhasBase() As Variant
Dim sNomeDasPlanilhas As String

'On Error GoTo aviso 'tendo erros, pula para aviso

    'Digite o nome das Planilhasonde os dados deverão ser procurados,
    'separados por ponto-e-vírgula (;)
    '
    sNomeDasPlanilhas = "cadastros"   '<----- Informe as planilhas aqui
    
    
    Do While (Right(sNomeDasPlanilhas, 1) = ";")
        sNomeDasPlanilhas = Left(sNomeDasPlanilhas, Len(sNomeDasPlanilhas) - 1)
    Loop
    
    ConfigPlanilhasBase = Split(sNomeDasPlanilhas, ";")
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"
    
End Function

Sub HabilitarControlesParaEdicao(ByVal bOpcao As Boolean)
    
'On Error GoTo aviso 'tendo erros, pula para aviso
    
    '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)
    'cmdSair.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)
    TextBox7.Locked = Not (bOpcao)
    TextBox8.Locked = Not (bOpcao)
    TextBox9.Locked = Not (bOpcao)
    TextBox10.Locked = Not (bOpcao)
    TextBox11.Locked = Not (bOpcao)
    TextBox12.Locked = Not (bOpcao)
    TextBox13.Locked = Not (bOpcao)
    TextBox14.Locked = Not (bOpcao)
    TextBox15.Locked = Not (bOpcao)
    TextBox16.Locked = Not (bOpcao)
    TextBox17.Locked = Not (bOpcao)
    TextBox18.Locked = Not (bOpcao)
    TextBox19.Locked = Not (bOpcao)
    TextBox20.Locked = Not (bOpcao)
    TextBox21.Locked = Not (bOpcao)
    TextBox22.Locked = Not (bOpcao)
    TextBox23.Locked = Not (bOpcao)
    TextBox24.Locked = Not (bOpcao)
    TextBox25.Locked = Not (bOpcao)
    TextBox26.Locked = Not (bOpcao)
    TextBox27.Locked = Not (bOpcao)
    TextBox28.Locked = Not (bOpcao)
    TextBox29.Locked = Not (bOpcao)
    TextBox30.Locked = Not (bOpcao)
    TextBox31.Locked = Not (bOpcao)
    TextBox32.Locked = Not (bOpcao)
    TextBox33.Locked = Not (bOpcao)
    TextBox34.Locked = Not (bOpcao)
    TextBox35.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 = ""
        TextBox7.Value = ""
        TextBox8.Value = ""
        TextBox9.Value = ""
        TextBox10.Value = ""
        TextBox11.Value = ""
        TextBox12.Value = ""
        TextBox13.Value = ""
        TextBox14.Value = ""
        TextBox15.Value = ""
        TextBox16.Value = ""
        TextBox17.Value = ""
        TextBox18.Value = ""
        TextBox19.Value = ""
        TextBox20.Value = ""
        TextBox21.Value = ""
        TextBox22.Value = ""
        TextBox23.Value = ""
        TextBox24.Value = ""
        TextBox25.Value = ""
        TextBox26.Value = ""
        TextBox27.Value = ""
        TextBox28.Value = ""
        TextBox29.Value = ""
        TextBox30.Value = ""
        TextBox31.Value = ""
        TextBox32.Value = ""
        TextBox33.Value = ""
        TextBox34.Value = ""
        TextBox35.Value = ""
        
        Combo_OndeSalvar.Visible = bOpcao
        Label_OndeSalvar.Visible = bOpcao
    End If
    
    If bOpcao = True Then
        TextBox1.SetFocus
    End If
    
'aviso:
    'MsgBox "Houve um erro ao realizar essa tarefa, verifique os dados e tente novamente!"

End Sub

Private Sub UserForm_Terminate()

    Worksheets("Menu").Activate

'    frmMenu.Show
    
    Unload Me
    
    'Docmd.Close
    
    'ThisWorkbook.Save True
End Sub
 
Postado : 16/08/2017 3:29 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Tecin, em primeiro lugar, sempre que colocar códigos, procure coloca-los entre as tags Code clicando no icone na barra.

O código é extenso, temos vários controles no formulário, mas ainda continuo achando que é problema do LISTVIEW, pelo menos é o que geralmente tem dado mais problema devido as versões e o mesmo não fazer mais parte de versões mais nova, e como você não citou qual controle estava como AUSENTE fica dificil, pois era para desativar e habilitar novamente. Então vamos por erro e acerto :
No frmBusca temos um controle LISTVIEW o qual é acessado pela instrução Call ConfigListView que se encontra no evento Initialize do formulário, então o primeiro teste e desabilitar esta chamada colocando um apostrofo na frente da linha, feito isto a mesma ficara com a fonte verde, se não ficar é porque não colocou certo, apos isto execute novamente o procedimento para abrir o formulário e veja se abre normal. Se abrir, o problema é a ausência da biblioteca do ListView.
Se for, você tem de ir no editor do VBA no menu Ferramentas / Referências e procurar pela referencia "Microsoft Windows Common Controls 6.0 (SP6)" e habilita-la, depois salvar o arquivo, habilitar novamente a instrução que foi desabilitada, salvar e reabrir o formulário, antes verifique se no formulário o Listview está lá.

Se ainda assim o erro persistir, de uma olhada no outro pc em que roda normalmente, no menu Ferramentas / Referencias e veja se as bibliotecas habilitadas são as mesmas que estão no pc formatado.

Por hora é isto, faça os testes e retorne.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 16/08/2017 4:47 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico