[es] - Microsoft ProgressBar Control

pmiroslav
Miroslav
Osijek

Član broj: 57354
Poruke: 298
*.dsl.optinet.hr.

+2 Profil

^{30.11.2007. u 09:02 - pre 199 meseci}

tako mi sada radi međutim ja bih to htio ubaciti u ovaj kod:

Private Sub Command15_Click()
Dim Baza As Database ' Deklaracije
Dim Sl_Table1 As Recordset
Dim Sl_Table2 As Recordset
Dim Sl_Trebovnica As Recordset
Dim Sl_ZbirnikKonacni As Recordset
Dim Zadani As Long
Dim Usl_Poz As String
Dim Sl_Poz As Recordset
Dim Sklop As String
Dim Podsklop As String
Dim Cvor As String
Dim tekuciSklop As String
Dim tekuciPodsklop As String
Dim tekuciCvor As String

'Dim stDocName As String

CurrentDb.Execute "DELETE*FROM [Shema]"
CurrentDb.Execute "DELETE*FROM [ShemaTransfer]"
CurrentDb.Execute "DELETE*FROM [ZbirnikKonacni]"

DoCmd.Hourglass True

DoCmd.OpenQuery "Stroj-grupa 00 append", acNormal, acEdit
DoCmd.OpenQuery "Stroj-grupa 01 append", acNormal, acEdit
DoCmd.OpenQuery "Stroj-grupa 02 append", acNormal, acEdit
DoCmd.OpenQuery "Stroj-grupa 03 append", acNormal, acEdit
DoCmd.OpenQuery "Stroj-grupa 04 append", acNormal, acEdit
DoCmd.OpenQuery "Stroj-grupa 05 append", acNormal, acEdit
DoCmd.OpenQuery "Stroj-grupa 06 append", acNormal, acEdit
DoCmd.OpenQuery "Stroj-grupa 07 append", acNormal, acEdit

DoCmd.Hourglass False
tekuciSklop = " " ' Inicijaljacije
tekuciPodsklop = " "
tekuciCvor = " "

Set Baza = CurrentDb() ' Setovanje
Set Sl_Table2 = Baza.OpenRecordset("ShemaTransfer", dbOpenDynaset) ' Tablica u koju se pohranjuju podaci
Set Sl_Table1 = Baza.OpenRecordset("QryShema", dbOpenDynaset) 'Qurey iz kojeg se uzimaju podaci

If Sl_Table1.RecordCount > 0 Then
'Sl_Table1.MoveFirst 'otidi na prvi slog Table1

While Not Sl_Table1.EOF ' vrti petlju za sve slogove
Sklop = Sl_Table1![IDSkl]
If Not IsNull(Sl_Table1![IDPskl]) Then
Podsklop = Sl_Table1![IDPskl]
End If
If Not IsNull(Sl_Table1![IDČv]) Then
Cvor = Sl_Table1![IDČv]
End If

If Sl_Table1![IDSkl] <> tekuciSklop Then ' dodaje slog za boravak u Table2

With Sl_Table2
.AddNew
![IDStroja] = Sl_Table1![IDStr]
![Nivo] = 1
![Index] = Sl_Table1![IndexSklop]
![IDDijela] = Sl_Table1![IDSkl]
![BrKomada] = Sl_Table1![KomSkl]
![BrKomadaSum] = Sl_Table1![KomSkl]
.Update
End With
End If

If Not IsNull(Sl_Table1![IDPskl]) And Sl_Table1![IDPskl] <> tekuciPodsklop Then
' dodaje slog za Podsklop
With Sl_Table2
.AddNew
![IDStroja] = Sl_Table1![IDStr]
![Nivo] = 2
![Index] = Sl_Table1![IndexPodsklop]
![IDDijela] = Sl_Table1![IDPskl]
![BrKomada] = Sl_Table1![KomPskl]
![BrKomadaSum] = Sl_Table1![KomPskl] * Sl_Table1![KomSkl]
.Update
End With
End If

If Not IsNull(Sl_Table1![IDČv]) And Sl_Table1![IDČv] <> tekuciCvor Then
' dodaje slog za Cvor
With Sl_Table2
.AddNew
![IDStroja] = Sl_Table1![IDStr]
![Nivo] = 3
![Index] = Sl_Table1![IndexCvor]
![IDDijela] = Sl_Table1![IDČv]
![BrKomada] = Sl_Table1![KomČv]
![BrKomadaSum] = Sl_Table1![KomČv] * Sl_Table1![KomPskl] * Sl_Table1![KomSkl]
.Update
End With
'End If
Usl_Poz = "SELECT * FROM [QryShema] WHERE ((([QryShema].IDSkl)= " & Sklop & ")" _
& "And (([QryShema].IDPskl)= " & Podsklop & ")" _
& "And (([QryShema].IDČv)= " & Cvor & "))"
Set Sl_Poz = Baza.OpenRecordset(Usl_Poz, dbOpenDynaset)
If Sl_Poz.RecordCount > 0 Then
'Sl_Poz.MoveFirst
While Not Sl_Poz.EOF ' dodaje slogove za Pozicije'''
With Sl_Table2
If Not IsNull(Sl_Table1![IDPoz]) Then
.AddNew
![IDStroja] = Sl_Table1![IDStr]
![Nivo] = 4
![Index] = Sl_Table1![IndexPoz]
![IDDijela] = Sl_Poz![IDPoz]
![BrKomada] = Sl_Poz![KomPoz]
![BrKomadaSum] = Sl_Poz![KomPoz] * Sl_Table1![KomČv] * Sl_Table1![KomPskl] * Sl_Table1![KomSkl]
.Update
End If
End With
Sl_Poz.MoveNext
Wend
End If
End If

tekuciSklop = Sklop
tekuciPodsklop = Podsklop
tekuciCvor = Cvor

Sl_Table1.MoveNext

Wend
Else
MsgBox "Nema podataka", vbInformation, "Obavestenje"
GoTo Kraj
End If

DoCmd.OpenQuery "ZbirnikQryApp", acNormal, acEdit
DoCmd.OpenQuery "ZbirnikPNDQryApp", acNormal, acEdit

Me![prgBar].Value = tekuciCvor / zadnji * 100
tekuciCvor = tekuciCvor + 1

MsgBox "Slaganje je izvršeno, izaberi dokument", vbInformation, "Gotov sam!"

Kraj:
Set Baza = Nothing

End Sub

Odgovor na temu

pmiroslav
Miroslav
Osijek

Član broj: 57354
Poruke: 298
*.dsl.optinet.hr.

+2 Profil

Re: Microsoft ProgressBar Control

^{30.11.2007. u 12:02 - pre 199 meseci}

Bravo !

dodao sam
Dim zadnji AS Long
Dim tekuci As Long

......
...... i

SL_SL_Table1.MoveLast
zadnji = Sl_Table1.RecordCount
tekuci = 1

i nakon
End If

Me![rgBar].Value = tekuci / zadnji *100
tekuci = tekuci +1

i sada to radi

( Me![prgBar]SetFocus sam isključio. )

Jedio nšro sada progres bar radi samo dok sevrti petlja za kopiranje iz tablice u tablicu, a ne radi dok se odrađuju komande početku:

CurrentDb.Execute "DELETE*FROM [Shema]" itd..

i na kraju :

DoCmd.OpenQuery "ZbirnikQryApp", acNormal, acEdit
DoCmd.OpenQuery "ZbirnikPNDQryApp", acNormal, acEdit

A taj dio zapravo traje malo duže.

Odgovor na temu