[Resolvido]Codigo e Barra de Progresso

Bom dia pessoal,
Busquei no Fórum um exemplo incrível para barra de progresso que conta os registros com base em uma tabela.
Preciso adaptar esse exemplo a uma consulta. Essa consulta reune dados de várias tabelas para emissão de recibos (boletos). Como Critério na consulta coloquei o campo data de vencimento. Gostaria que o usuário do sistema chamasse a consulta através de um formulário e quando ele digitasse o intervalo de datas de vencimento ou seja documentos que irão vencer de 01/01/2011 a 30/01/2011 executasse a barra de progresso e logo após aparecesse a visualização dos recibos como faço isso ?
Abraços,

Gerson

Basta executar o código da barra substituindo a tabela pela consulta.. e ao final carregar o recordSource do relatorio com a SQL contendo as mesmas Data Inicial e Data final do form.. e depois que carregar.. abri-lo

Hary, me ajude com isso... ai embaixo segue o código
Private Sub Form_Open(Cancel As Integer)

Set rs = CurrentDb.OpenRecordset("ImprimeBoleto")
n_Reg = rs.RecordCount

On Error GoTo Proc_Err

If Len(Me.OpenArgs & "") > 0 Then
n_Reg = Me.OpenArgs
End If

RegOcx "MSCOMCTL.OCX"

Proc_Exit:
Exit Sub
Proc_Err:
Select Case Err.Number
Case Else
Select Case ErrorDisplay(Err.Number, Error$, mcStrModule, "Form_Open", Erl())
Case errContinue
Resume Next
Case errexit
Resume Proc_Exit
End Select
End Select
rs.Close

End Sub

Amigao.. se possivel envie-me parte do BD.. ainda não sou tão fera a ponto de modificar apenas o código puro assim.. mas se me enviar posso observar toda a logica de funcionamento e encontrar uma solução...

Aguardo..

Aí vai Hary,

https://dl-web.dropbox.com/get/Teste.mdb?w=d48f4267

Erro Drop 403... envie-me no e-mail por gentileza...

Harysohn@hotmail.com

Mandei via email

Gerson Amigao.. esta em mdb... e o hotmail bloqueou.. compacte-o com o winrar e me reenvie por gentileza..

Cumprimentos

Vamos la Amigao.. o form Progresso faz referencia a uma consulta que nao existe (Consulta1)
O codigo que postou la acima ele vai onde?

De a descricao do funcionamento que pretende...

Cunprimentos

Então Hary,
Abra o formulário formImprime digita na caixa uma data ex: 25/11/2011 para satisfazer o critério da consulta, neste momento no formulario aparecerá os boletos que vencerão nesta data é ai que eu quero criar um botão para imprimir os registros enquanto isso ocorre roda a barra de progresso que contaria os registros.

Repare que existem 3
registros talvez seja o caso de alterar o formulário para formulário contínuo a ideia é imprimir todos os registros que satisfaçam os critério que no caso é a data de vencimento.

Eu nao estou e conseguindo rodar essa barra.. adicionei uma tabela no código e deu tipos incompativeis...

Creio que falta uma dll... ou OCX

Vou mandar para o seu email o BD Original da barra.

Vamos lá amigão???

Sua solução Amigão:

Resstruturei todo o FormImprime

1 - Caixas texto DstaInicial e Final
2 - Botão CarregaR Boleto que executa código para carregar o RecordSource do Form
2.1 - As caixa texto ficam em ocultas, so tornando-se visiveis após o carregamento do RecordSource do Form, para não aparecerem com erro visto que o form não esta carregado
3 - List Box carregada tambem atraves do botão, carregando com as informações filtradas pelos campos data acima
3.1 - Observe que é possivel navegar pelos registros ao click da listBox
3.2 - Caixa texto abaixo da list que conta os registros existentes entre as datas
4 - Botão Imprimir boletos, este botão executa o FrmProgresso que utiliza a informação da Caixatexto com o numero de registros, para fazer o loop nos registros filtrados, efetuando assim sua contagem no progresso...
5 - Apos o final do loop o formProgresso é fechado e é aberto o relatorio que tem por base a consulta imprimeBoleto, que tem como critérios os campos no form, e assim abrindo a informação compatível no form...


Cósigos:

BOTÃO CARREGAR BOLETO

Código:

Private Sub Comando5_Click()
Dim rs As DAO.Recordset
Dim StrSQL As String
Dim StrSQLList As String


If IsNull(Me.txtDataInicial) Or Me.txtDataInicial = "" Then
    MsgBox "Preencha uma data válida", vbCritical, "Atenção"
Exit Sub
Else

StrSQL = "SELECT tbl_Parcelas.Num_seq AS BolCodi, Contratos.Num_OR AS Contrato," _
        & "tbl_Parcelas.Num_parc AS Parcela, tbl_Parcelas.Val_parc AS BolValor," _
        & "tbl_Parcelas.Data_venc AS Boldtvencto," _
        & "CodBarrasBB('001','9',[BolValor],'867598' & [NossoNumero] & '21') AS CodBarra," _
        & "Mid([CodBarra],5,1) AS DVCodBarras, NossoNumero([BolCodi] & '1087615') AS NossoNumero," _
        & "LinhaDig('00191087615' & [NossoNumero] & '21',[DVCodBarras],[BolValor]) AS LinhaDig," _
        & "18 AS Carteira, '0435-9' AS Agencia, '21983-5' AS Cedente, ' ' AS CLI_CODI," _
        & "Clientes.Nome AS BolSAcado, Clientes.LogrTipo, Clientes.Endereço AS LogrNome, Clientes.Nº AS LogrNum," _
        & "Clientes.Complemento AS LogrCompl, Clientes.Bairro AS LogrBairro, Clientes.Cep AS LogrCep," _
        & "Clientes.Cidade AS LogrCidade, Clientes.Estado AS LogrEstado, Clientes.UF AS LogrUF," _
        & "ConLote.Loteamentos AS Loteamento, ConLote.Quadra, ConLote.Lote" _
        & " FROM ((Contratos INNER JOIN tbl_Parcelas ON Contratos.Num_OR = tbl_Parcelas.Num_OR)" _
        & " INNER JOIN Clientes ON Contratos.Nome_Cliente = Clientes.CodCli)" _
        & "INNER JOIN ConLote ON Contratos.CodLote = ConLote.CodLote WHERE  ((tbl_Parcelas.Data_venc >=#" & Format(Me.txtDataInicial, "dd/mm/yyyy") & "#) And  (tbl_Parcelas.Data_venc <=#" & Format(Me.txtDataFinal, "dd/mm/yyyy") & "#));"

StrSQLList = "SELECT tbl_Parcelas.Num_seq, Contratos.Num_OR AS Contrato, tbl_Parcelas.Val_parc AS BolValor," _
        & "tbl_Parcelas.Data_venc AS Boldtvencto,Clientes.Nome AS BolSAcado" _
        & " FROM ((Contratos INNER JOIN tbl_Parcelas ON Contratos.Num_OR = tbl_Parcelas.Num_OR)" _
        & " INNER JOIN Clientes ON Contratos.Nome_Cliente = Clientes.CodCli)" _
        & "INNER JOIN ConLote ON Contratos.CodLote = ConLote.CodLote WHERE ((tbl_Parcelas.Data_venc >=#" & Format(Me.txtDataInicial, "dd/mm/yyyy") & "#) And  (tbl_Parcelas.Data_venc <=#" & Format(Me.txtDataFinal, "dd/mm/yyyy") & "#));"
Me.RecordSource = StrSQL
Me.ListDados.RowSource = StrSQLList

Me.Rótulo0.Visible = True
Me.Rótulo1.Visible = True
Me.Rótulo2.Visible = True
Me.Contrato.Visible = True
Me.Boldtvencto.Visible = True
Me.BolSAcado.Visible = True
Me.BtnRelatorio.Enabled = True
End If
End Sub

CLICK DA LISTA

Código:

Private Sub ListDados_AfterUpdate()
  ' Localizar o registo que corresponde ao controlo.
    Dim rs As Object

    Set rs = Me.Recordset.Clone
    rs.FindFirst "[BolCodi] = " & Str(Nz(Me![ListDados], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub

BOTÃO IMPRIMIR BOLETO

Código:

Private Sub BtnRelatorio_Click()
DoCmd.OpenForm "frmProgresso"
End Sub

AO ABRIR O FORMPROGRESSO (Observe a referencia a caixa texto com o valor dos registros (aqui é usado para efetuar o loop)

Private Sub Form_Open(Cancel As Integer)

n_Reg = Forms!FormImprime.txtNumBol
On Error GoTo Proc_Err

If Len(Me.OpenArgs & "") > 0 Then
n_Reg = Me.OpenArgs
End If

RegOcx "MSCOMCTL.OCX"

Proc_Exit:
Exit Sub
Proc_Err:
Select Case Err.Number
Case Else
Select Case ErrorDisplay(Err.Number, Error$, mcStrModule, "Form_Open", Erl())
Case errContinue
Resume Next
Case errexit
Resume Proc_Exit
End Select
End Select
rs.Close

End Sub


http://dl.dropbox.com/u/26441349/Gerson_Boletos.rar

Saudações

Ficou excelente Hary.
Você se superou nesta espero que outros colegas aproveitem esse exemplo muito obrigado pelo trabalho e pela aula.
Abração,

Gerson

O Fórum agradece o Retorno.. Bom trabalho Amigão.

Uma dica..

Ai tambem da pra utilizar uma combo para carregar o form por Sacado(Cliente)