Página 1 de 1

Atualizar dados ao recalcular

Enviado: Qui Dez 27, 2018 2:38 pm
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?

Re: Atualizar dados ao recalcular

Enviado: Qui Dez 27, 2018 8:09 pm
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

Re: Atualizar dados ao recalcular

Enviado: Qui Dez 27, 2018 8:35 pm
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 é......

Re: Atualizar dados ao recalcular

Enviado: Qui Dez 27, 2018 8:40 pm
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