PROGRESSBAR EM TEMPO REAL

XXXANGELSXXX 11/12/2009 09:46:42
#329507
Amigos, eu de novo.. aqui, seguinte, tenho uma rotina no sistema de gravar valores de contrato apartir de outra tabela, o processo é um pouquinho demorado, eu coloquei uma progressbar, so que ela carrega quase que instanteamente, ou seja, o processo de gravaçao no banco nem terminou e a progress ja carregou tudo, eu queria o seguinte.. a medida que ele realmente ir importando que a progress vai carregando.. entenderam? olha a funçao que estou usando..


Sub FU_GRAVAVALORESCONTRATO()
Me.Caption = [Ô]Gravando Valores dos Novos Contratos[Ô]
On Error Resume Next
Dim strSql As String
Dim rsValorSomado As ADODB.Recordset

If ConectarBDados Then
Set rs = New ADODB.Recordset

strSql = [Ô]select * from CadClientes[Ô]
rs.CursorLocation = adUseClient
rs.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic

While Not rs.EOF

strSql = [Ô]select sum(AuxClientes.ValorManut) as total from AuxClientes where AuxClientes.CodCliente = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
Set rsValorSomado = New ADODB.Recordset
rsValorSomado.CursorLocation = adUseClient
rsValorSomado.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic

If Not rsValorSomado.EOF Then

strSql = [Ô]update CadClientes set CadClientes.CliCadValor = [ô][Ô] & rsValorSomado!Total & [Ô][ô] Where CadClientes.clicodigo = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
cn.Execute strSql
End If
bar.Visible = True
bar.Value = bar.Value + 1
rs.MoveNext


Wend

rs.Close
Set rs = Nothing
Else
cn.Close
Set cn = Nothing
End If
bar.Value = bar.Value = 0

End Sub
PARREIRA 11/12/2009 10:17:43
#329511
Sub FU_GRAVAVALORESCONTRATO()
Me.Caption = [Ô]Gravando Valores dos Novos Contratos[Ô]
On Error Resume Next
Dim strSql As String
Dim rsValorSomado As ADODB.Recordset

If ConectarBDados Then
Set rs = New ADODB.Recordset

strSql = [Ô]select * from CadClientes[Ô]
rs.CursorLocation = adUseClient
rs.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic

While Not rs.EOF

bar.nax = re.recordcont '[ô]coloca isso

strSql = [Ô]select sum(AuxClientes.ValorManut) as total from AuxClientes where AuxClientes.CodCliente = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
Set rsValorSomado = New ADODB.Recordset
rsValorSomado.CursorLocation = adUseClient
rsValorSomado.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic

If Not rsValorSomado.EOF Then

strSql = [Ô]update CadClientes set CadClientes.CliCadValor = [ô][Ô] & rsValorSomado!Total & [Ô][ô] Where CadClientes.clicodigo = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
cn.Execute strSql
End If
bar.Visible = True
bar.Value = bar.Value + 1
rs.MoveNext


Wend

rs.Close
Set rs = Nothing
Else
cn.Close
Set cn = Nothing
End If
bar.Value = bar.Value = 0

End Sub


coloca dentro do loop bar.max = rs.recordcont
PARREIRA 11/12/2009 10:19:31
#329513
Ops quer dizer fora do loop logo ni inicio!
PARREIRA 11/12/2009 10:21:13
#329515
E bar.value = bar,value + 1 fica dentro do loop
TECLA 11/12/2009 10:22:01
#329516 Resposta escolhida 
[txt-color=#006400][ô]...[/txt-color]
bar.Value = 0
bar.Max = rs.RecordCount
While Not rs.EOF     
            strSql = [Ô]select sum(AuxClientes.ValorManut) as total from AuxClientes where AuxClientes.CodCliente = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
            Set rsValorSomado = New ADODB.Recordset
            rsValorSomado.CursorLocation = adUseClient
            rsValorSomado.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic
            
            If Not rsValorSomado.EOF Then
                   strSql = [Ô]update CadClientes set CadClientes.CliCadValor = [ô][Ô] & rsValorSomado!Total & [Ô][ô] Where CadClientes.clicodigo = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
                   cn.Execute strSql
           End If
           bar.Visible = True
           bar.Value = bar.Value + 1
           rs.MoveNext         
Wend
[txt-color=#006400][ô]...[/txt-color]
XXXANGELSXXX 11/12/2009 10:26:08
#329517
Citação:

PARREIRA escreveu:
Ops quer dizer fora do loop logo ni inicio!

Amigo, nao deu certo nao.. ele continua carregando errado ainda..
XXXANGELSXXX 11/12/2009 10:35:07
#329520
Citação:

TECLA escreveu:

[txt-color=#006400][ô]...[/txt-color]
bar.Value = 0
bar.Max = rs.RecordCount
While Not rs.EOF     
            strSql = [Ô]select sum(AuxClientes.ValorManut) as total from AuxClientes where AuxClientes.CodCliente = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
            Set rsValorSomado = New ADODB.Recordset
            rsValorSomado.CursorLocation = adUseClient
            rsValorSomado.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic
            
            If Not rsValorSomado.EOF Then
                   strSql = [Ô]update CadClientes set CadClientes.CliCadValor = [ô][Ô] & rsValorSomado!Total & [Ô][ô] Where CadClientes.clicodigo = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
                   cn.Execute strSql
           End If
           bar.Visible = True
           bar.Value = bar.Value + 1
           rs.MoveNext         
Wend
[txt-color=#006400][ô]...[/txt-color]

é Amigo.. vc deu uma sumida do forum.. rs rs.. aqui, coloquei como vc me disse, e nao deu certo, ou seja, agora ela nem carrega..
PARREIRA 11/12/2009 10:35:20
#329521
coloque doevents logo apos bar.value = bar.value + 1.
LEANDRO 11/12/2009 10:43:05
#329525 
Sub FU_GRAVAVALORESCONTRATO()
Me.Caption = [Ô]Gravando Valores dos Novos Contratos[Ô]
On Error Resume Next
  Dim strSql As String
    Dim rsValorSomado As ADODB.Recordset
    
    If ConectarBDados Then
        Set rs = New ADODB.Recordset
    
        strSql = [Ô]select * from CadClientes[Ô]
        rs.CursorLocation = adUseClient
        rs.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic
        bar.Max = rs.RecordCount
    While Not rs.EOF
                  
            strSql = [Ô]select sum(AuxClientes.ValorManut) as total from AuxClientes where AuxClientes.CodCliente = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
            Set rsValorSomado = New ADODB.Recordset
            rsValorSomado.CursorLocation = adUseClient
            rsValorSomado.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic
            
            If Not rsValorSomado.EOF Then
           
 strSql = [Ô]update CadClientes set CadClientes.CliCadValor = [ô][Ô] & rsValorSomado!Total & [Ô][ô] Where CadClientes.clicodigo = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
         cn.Execute strSql
         End If
         bar.Visible = True
         bar.Value = bar.Value + 1
        rs.MoveNext
        Wend

        rs.Close
        Set rs = Nothing
    Else
        cn.Close
        Set cn = Nothing
    End If
End Sub
TECLA 11/12/2009 10:48:04
#329527
As reticências (...) quer dizer, que o código que vem ANTES e DEPOIS dela não foi alterado.
De qualquer forma, segue a rotina completa.

Sub FU_GRAVAVALORESCONTRATO()
Me.Caption = [Ô]Gravando Valores dos Novos Contratos[Ô]
On Error Resume Next
  Dim strSql As String
    Dim rsValorSomado As ADODB.Recordset
    
    If ConectarBDados Then
        Set rs = New ADODB.Recordset
    
        strSql = [Ô]select * from CadClientes[Ô]
        rs.CursorLocation = adUseClient
        rs.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic
        
        bar.Value = 0
        bar.Max = rs.RecordCount

    While Not rs.EOF
            DoEvents
       
            strSql = [Ô]select sum(AuxClientes.ValorManut) as total from AuxClientes where AuxClientes.CodCliente = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
            Set rsValorSomado = New ADODB.Recordset
            rsValorSomado.CursorLocation = adUseClient
            rsValorSomado.Open strSql, cn, adOpenDynamic, adLockBatchOptimistic
            
            If Not rsValorSomado.EOF Then
            
            strSql = [Ô]update CadClientes set CadClientes.CliCadValor = [ô][Ô] & rsValorSomado!Total & [Ô][ô] Where CadClientes.clicodigo = [ô][Ô] & Trim(rs!CliCodigo) & [Ô][ô][Ô]
            cn.Execute strSql
            End If
          bar.Visible = True
          bar.Value = bar.Value + 1
            rs.MoveNext
        
            
        Wend

        rs.Close
        Set rs = Nothing
    Else
        cn.Close
        Set cn = Nothing
    End If
         bar.Value = bar.Value = 0

End Sub
Tópico encerrado , respostas não são mais permitidas
Voltar