[Resolvido]Barra de progresso lendo uma tabela

Boa tarde amigos.

eu peguei um exemplo de uma barra de progresso que lê cadastro de uma tabela o autor é desconhecido e estou tentando adaptar para meu formulário.

tenho um formulário de nome frmPercentual01 que esta vinculado a uma tabela Funcionario, o formulário abre direitinho porem ele lê 500 cadastros efetuado na tabela e tenho + de 1000 cadastro, quando ele chega nos 500 que é 73% dos cadastros realizados ele diz que não pode ir para o proximo registro e para ai,abaixo vai os comandos do formulário.

Espero poder contar com ajuda de um dos colegas. O que quero é que ele conte todos os cadstros e não uma parte.


Option Compare Database
Option Explicit
Public MaxGauge As Integer, PsGauge As Integer, LarguraGauge As Integer

Private Sub Avançar_Click()
Dim Percent As Integer
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Set DB = CurrentDb
Set RS = DB.OpenRecordset("Funcionario")

RS.MoveFirst
RS.MoveLast
Percent = RS.RecordCount
PsGauge = 0
Forms!frmPercentual01!Gauge2.Caption = "0 %"
LarguraGauge = Forms!frmPercentual01!Gauge.Width
Forms!frmPercentual01!Gauge.Width = 0

RS.MoveFirst
Do While Not RS.EOF

Avança

PsGauge = PsGauge + 1
Forms!frmPercentual01!Gauge2.Caption = CStr(CInt(PsGauge * 100 / Percent)) + " %"
Forms!frmPercentual01!Gauge.Width = (PsGauge / Percent) * LarguraGauge
Forms!frmPercentual01!txtPrefixo.Value = RS!Cracha
Forms!frmPercentual01!txtAgencia.Value = RS!NomeF

RS.MoveNext
Loop
Set RS = Nothing
Set DB = Nothing

End Sub

Sub Avança()

Dim iCount As Integer
iCount = Nz(DCount("Cod", "Funcionario"), 0)
If iCount = Me.CurrentRecord Then
MsgBox "Você já chegou ao último registro", vbInformation, "Atenção"
DoCmd.GoToRecord , , acFirst
Else

DoCmd.GoToRecord , , acNext 'o erro acontese aqui empedindo de passar para números superio dos 500
End If

End Sub

Private Sub Fechar_Click()

DoCmd.Close

End Sub

Private Sub Form_Open(Cancel As Integer)

DoCmd.Restore
Avançar_Click

End Sub

Function GetLineNumber() As Long

On Error Resume Next
RecordsetClone.Bookmark = Bookmark
If Err = 0 Then
GetLineNumber = RecordsetClone.AbsolutePosition + 1
End If

End Function

pNa sua tabela, as chaves primarias apos o 500 continuam sequenciais ou tem algum salto?


Tente desabilitar a sub avanca no codigo e observe o que acontece..



Forms!frmPercentual01!Gauge.Width = 0

RS.MoveFirst Do While Not RS.EOF

'Avança


PsGauge = PsGauge + 1

não deu certo amigão

Vai o bd para você ver e eu vou ficar tentando aqui.

obrigado pela atenção.

Tente assim:

Public MaxGauge, PsGauge, LarguraGauge

Private Sub Avançar_Click()
Dim Percent As Integer
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Set DB = CurrentDb
Set RS = DB.OpenRecordset("Funcionario")

'RS.MoveFirst
RS.MoveLast
Percent = RS.RecordCount
PsGauge = 0
Forms!frmPercentual01!Gauge2.Caption = "0 %"
LarguraGauge = Forms!frmPercentual01!Gauge.Width
Forms!frmPercentual01!Gauge.Width = 0

RS.MoveFirst
Do While Not RS.EOF

Avança

PsGauge = PsGauge + 1
Forms!frmPercentual01!Gauge2.Caption = CStr(CInt(PsGauge * 100 / Percent)) + " %"
Forms!frmPercentual01!Gauge.Width = (PsGauge / Percent) * LarguraGauge
Forms!frmPercentual01!txtPrefixo.Value = RS!Cracha
Forms!frmPercentual01!txtAgencia.Value = RS!NomeF

RS.MoveNext
Loop
Set RS = Nothing
Set DB = Nothing

End Sub

Bom dia Jungli, deo tudo certinho agora a barra de grogresso verifica todos os registros da tabela.

muito obrigado amigo.

Fico feliz em ajudar ...
O fórum agradece o retorno.