[Resolvido]Barra de Progresso

Bom dia Prezados!

recebi esta solução do Harysohn

que foi de grande eficiência. Agora gostaria de criar uma barra de progresso para este código

Alguém pode me ajudar?


Private Sub btnAtualizar_Click()
Dim Db As DAO.Database 'Declaração DAO para o banco de dados
Dim Rs As DAO.Recordset 'Declaração para o RecordSet
Dim ws As DAO.Workspace 'Declaração para o Workspace
Dim StrSql As String 'Variável que receberá a SQL
Dim StrTMP As Double 'Variável que armazenará o numero que será atualizado nos proximos campos null

Set ws = DBEngine.Workspaces(0) 'Seta o Workspace
Set Db = ws.OpenDatabase(CurrentProject.Path & "\BDExemplo.accdb", False, False, "MS Access;PWD=senha") 'Seta o BD aplicando o caminho, observe que tem que conter o nome do banco de dados

StrSql = "SELECT * FROM TblExemplo" 'Carrega a variável StrSql com a SQL da tabela
Set Rs = Db.OpenRecordset(StrSql) 'Seta o recordset para abrir com a SQL

If Rs.RecordCount = 0 Then 'Se não existe registro no recordset exibe a mensagem abaixo
MsgBox "sem registro selecionado", vbInformation, "Atenção"
Else 'Caso contrário prosegue o código aplicando na variável StrTMP o valor zero
StrTMP = 0

Do While Not Rs.EOF

If IsNull(Rs!Campo1) = True Then 'O codigo será executado em loop's sequenciais, armazenando o valor do campo1 na variável StrTMP, caso o proximo registro seja nulo, atualiza o registro com a variável StrTMP que é justamente o registro anterior, agindo assim sucessivamente enquanto houver registros nulos, cessando quando o registro seguinte contiver nova numeração, ai carrega novamente a variável StrTMP com o valor do Campo1 e prossegue novamente, em encontrado registro nulo, atualiza.. e assim sucessivamente
CurrentDb.Execute "UPDATE TblExemplo SET Campo1= '" & StrTMP & "' WHERE Código =" & Rs!Código & ";"
Else
StrTMP = Rs!Campo1 'Caso o proximo registro não seja nulo, carrega novamente a variável com o valor não nulo seguinte

End If

Rs.MoveNext 'Vai ao proximo registro do Recordset
Loop 'Executa o Loop

'Exibe mensagem ao final da atualização
MsgBox "Atualizado com Sucesso!", vbInformation, "Atualizado"
End If
End Sub


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

Boa noite, dbragion

Coloque rótulo e denomine-o RtlPercentagem


Private Sub btnAtualizar_Click()
Dim Db As DAO.Database
Dim Rs As DAO.Recordset
Dim ws As DAO.Workspace
Dim StrSql As String
Dim StrTMP As Double
Dim QtRegistos As Integer

Set ws = DBEngine.Workspaces(0)
Set Db = ws.OpenDatabase(CurrentProject.Path & "\BDExemplo.accdb", False, False, "MS Access;PWD=senha")

RtlPercentagem.Caption = ""
StrSql = "SELECT * FROM TblExemplo"
Set Rs = Db.OpenRecordset(StrSql)

If Rs.RecordCount = 0 Then
MsgBox "sem registro selecionado", vbInformation, "Atenção"
Else
StrTMP = 0
Rs.MoveLast: Rs.MoveFirst
QtRegistos = Rs.RecordCount
Do While Not Rs.EOF
RtlPercentagem.Caption = Format((Rs.AbsolutePosition + 1) / QtRegistos, "# %")
If IsNull(Rs!Campo1) = True Then
CurrentDb.Execute "UPDATE TblExemplo SET Campo1= '" & StrTMP & "' WHERE Código =" & Rs!Código & ";"
Else
StrTMP = Rs!Campo1

End If

Rs.MoveNext
Loop
MsgBox "Atualizado com Sucesso!", vbInformation, "Atualizado"
End If
End Sub

Muito obrigado, funcionou!

no arquivo teste, vou fazer no origina que está com cerca de 80 mil linhas e retorno

obrigado

Att

Daniel