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

Atualizar dados ao recalcular

Esclarecimentos e dúvidas sob o Modelo de Aplicativo de Cadastro em VBA no Microsoft Excel publicado no site e blog http://www.tomasvasquez.com.br
NERI INACIO
Colaborador
Colaborador
Mensagens: 62
Registrado em: Sáb Fev 27, 2016 7:31 pm

Atualizar dados ao recalcular

Mensagem por NERI INACIO »

Ao iniciar a planilha, utilizo o comando abaixo para atualizar os dados e funciona certo:

Código: Selecionar todos

Private Sub UserForm_Initialize()
Dim Caminho As String
Caminho = Plan1.Range("b3").Value

Workbooks.Open Caminho
Call DefinePlanilhaDados

Windows(NomeArquivo).Visible = True 'False 'oculta o arquivo de dados
 
PopulaListBox
cbomes.SetFocus

cbomes.Value = Workbooks(NomeArquivo).Sheets("Auxiliar").Range("j1").Value
CboAno.Value = Workbooks(NomeArquivo).Sheets("Auxiliar").Range("k1").Value

 
Me.Label1.Caption = "Total de Registros: " & Format(Me.ListView1.ListItems.Count, "000")

Dim i& ' Zebrar linhas
    hWnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5) ' Zebrar linhas
    
    ListView1.ColumnHeaders.Clear
       With ListView1
            .FullRowSelect = True 'seleciona linha
            .View = lvwReport
       '     .HideColumnHeaders = True 'IráOcultar a Linha de Cabeçalho no listview
           .ColumnHeaders.Add Text:="Codigo", Width:=0
           .ColumnHeaders.Add Text:="Data", Width:=60
           .ColumnHeaders.Add(, , "Vlr Total Pagar", Width:=83, Alignment:=1).Tag = "number"
           .ColumnHeaders.Add(, , "Vlr Pago", Width:=83, Alignment:=1).Tag = "number"
           .ColumnHeaders.Add(, , "Vlr a Pagar", Width:=85, Alignment:=1).Tag = "number"
           .ColumnHeaders.Add(, , "Vlr Total Receber", Width:=85, Alignment:=1).Tag = "number"
           .ColumnHeaders.Add(, , "Vlr Recebido", Width:=85, Alignment:=1).Tag = "number"
           .ColumnHeaders.Add(, , "Vlr a Receber", Width:=85, Alignment:=1).Tag = "number"

           .Gridlines = True 'efeito grade
        End With
 Calculos

OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc) ' Zebrar linhas
End Sub
Como tenho duas comboboxes (mês e Ano), posso alterar as mesmas e depois disto preciso atualizar os dados novamente.
Sendo assim, inseri um botão chamado Atualizar. Mas estou com problemas na atualização, ou seja, não consigo fazer atualizar.

Já fiz o teste e sei que na planilha os dados são recalculados corretamente, porém no meu listview eu preciso atualizar.
Já coloquei o seguinte comando:
Private Sub BtnAtualizar_Click()
PopulaListBox
End Sub
Não funcionou. Como os dados estão em planilha separada acredito que devo colocar mais algum comando junto. Mas com certeza o comando deve estar dentro do initialize, pois, se fechar o listview e volto a exibir ele, está correto. Sendo assim, o comando deve estar lá, mas não consigo ajustar.

Alguém me ajuda?


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
Reinaldo
Jedi
Jedi
Mensagens: 1537
Registrado em: Sex Ago 01, 2014 4:09 pm
Localização: Garça - SP / SCS - SP

Re: Atualizar dados ao recalcular

Mensagem por Reinaldo »

Qual o codigo em "popula..."??
Qual a razão de utilizar ComboBox, se tera somente um mes e um ano? Creio que o ideal seria TextBox

Código: Selecionar todos

cbomes.Value = Workbooks(NomeArquivo).Sheets("Auxiliar").Range("j1").Value
CboAno.Value = Workbooks(NomeArquivo).Sheets("Auxiliar").Range("k1").Value


NERI INACIO
Colaborador
Colaborador
Mensagens: 62
Registrado em: Sáb Fev 27, 2016 7:31 pm

Re: Atualizar dados ao recalcular

Mensagem por NERI INACIO »

Reinaldo
Até pode ser textbox. O motivo de combobox é evitar o erro de digitação. Como exemplo, ao invés de digitar "JAN" para Janeiro, o usuário escreva "JAM" ou qualquer outra coisa. Este é o único motivo.
Mas, pode ser textbox.

Mas assim... estou vendo que ao usar a combobox chamada cbomes, no change, este é enviado para a planilha e calcula corretamente. A única coisa é que não atualiza o meu relatório. Ainda não descobri o motivo.

Veja que, se fechar o formulário e voltar a abrir, ele carrega os dados corretamente, com a alteração que fiz na combobox.

Fiz um outro teste (e não deu certo também:
Coloquei todo o comando do initialize para dentro do botão atualiza. Deve ser um erro pequeno e besta. Mas não estou vendo o que é......


NERI INACIO
Colaborador
Colaborador
Mensagens: 62
Registrado em: Sáb Fev 27, 2016 7:31 pm

Re: Atualizar dados ao recalcular

Mensagem por NERI INACIO »

Não respondi esta parte antes....

Código: Selecionar todos

Private Sub PopulaListBox()
Calculos
    On Error GoTo TrataErro

    Dim conn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sql As String
    Dim sqlWhere As String
    Dim sqlOrderBy As String
    Dim i As Integer
    Dim campo As Field
    Dim myArray() As Variant

    Set conn = New ADODB.Connection
    With conn
        .Provider = "Microsoft.ACE.OLEDB.12.0" 'Microsoft.JET.OLEDB.4.0 - Depende a Versao do Excel
        .ConnectionString = "Data Source=" & caminhoArquivoDados & ";Extended Properties=Excel 8.0;"
        .Open
    End With

    sql = "SELECT [Resumo$].[Codigo] ,"
    sql = sql & "[Resumo$].[Data], "
    sql = sql & "[Resumo$].[Pagar] ,[Resumo$].[Pago] ,[Resumo$].[APagar], "
    sql = sql & "[Resumo$].[Receber] , [Resumo$].[Recebido] , [Resumo$].[AReceber] "

   
    
    sql = sql & "FROM [Resumo$]"  'Nome das Planilhas da procura nome
    
    sql = sql & "WHERE [resumo$].[Data] = [resumo$].[Data] "
    
    'monta a cláusula WHERE
    Call MontaClausulaWhere(cbomes.Name, "[resumo$].[Data]", sqlWhere)


    'faz a união da string SQL com a cláusula WHERE
    If sqlWhere <> vbNullString Then
        sql = sql & " AND " & sqlWhere
    End If
    
    sql = sql & " ORDER BY [resumo$].[Codigo] " ' monta a sql com o codigo da OC
    
    Set rst = New ADODB.Recordset
    With rst
        .ActiveConnection = conn
        .Open sql, conn, adOpenDynamic, _
              adLockBatchOptimistic
    End With

    'pega o número de registros para atribuí-lo ao listbox
   ' lstLista.ColumnCount = rst.Fields.Count

    'coloca as linhas do RecordSet num Array, se houver linhas neste
    If Not rst.EOF And Not rst.BOF Then
        
    '...................................................................
' Codigo abaixo Adiciona colunas
    ListView1.ListItems.Clear

   While Not rst.EOF
        Set li = ListView1.ListItems.Add(Text:=Format(rst.Fields(0).Value, "00000"))
        li.ListSubItems.Add Text:=rst.Fields(1).Value
          
          If IsNull(rst.Fields(2).Value) Then
            li.ListSubItems.Add Text:=""
          Else
            li.ListSubItems.Add Text:=Format(rst.Fields(2).Value, "#,##0.00")
          End If
          
          If IsNull(rst.Fields(3).Value) Then
            li.ListSubItems.Add Text:=""
          Else
            li.ListSubItems.Add Text:=Format(rst.Fields(3).Value, "#,##0.00")
          End If
          
          If IsNull(rst.Fields(4).Value) Then
            li.ListSubItems.Add Text:=""
          Else
            li.ListSubItems.Add Text:=Format(rst.Fields(4).Value, "#,##0.00")
          End If
          
          If IsNull(rst.Fields(5).Value) Then
            li.ListSubItems.Add Text:=""
          Else
            li.ListSubItems.Add Text:=Format(rst.Fields(5).Value, "#,##0.00")
          End If
          
          If IsNull(rst.Fields(6).Value) Then
            li.ListSubItems.Add Text:=""
          Else
            li.ListSubItems.Add Text:=Format(rst.Fields(6).Value, "#,##0.00")
          End If
          
          If IsNull(rst.Fields(7).Value) Then
            li.ListSubItems.Add Text:=""
          Else
            li.ListSubItems.Add Text:=Format(rst.Fields(7).Value, "#,##0.00")
          End If
   
          rst.MoveNext
    Wend
    End If


    ' Fecha o conjunto de registros.
    Set rst = Nothing
    ' Fecha a conexão.
    conn.Close

TrataSaida:
    Exit Sub
TrataErro:
    Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
    Resume TrataSaida
    
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