Prikazi cijelu temu 11.03.2014 20:34
pmiroslav Van mreze
Clan
Registrovan od:02.02.2009
Lokacija:Osijek


Predmet:Progress bar
Pri kraju proÅ¡le teme (Relink sa viÅ¡e kompjutera) ZXZ mi je pomogao da napravim progress bar koji radi za vrijeme dok funkcija relinkovanja odradi svoje. To radi savrÅ¡eno i čini aplikaciju profesionalnijom.
U svojoj aplikaciji imama još jedan kompleksniji kod koji radi relativno dugo pa me zanima dali bi se i ovdje mogao ubaciti progres bar.
Prvo sd dugmetom na formi pokreće Private Sub C_Slozi_Click():
PreuzmiIzvorni kôd (vbnet):
  1. Private Sub C_Slozi_Click()
  2. On Error GoTo Err_C_Slozi_Click
  3.     Dim Baza As Database
  4.     Dim Sl_ULAZNA As Recordset
  5.     Dim Sl_Zavrsna As Recordset
  6.     Dim Sl_Duplikati As Recordset
  7.     Dim Sl_Pretrage As Recordset
  8.     Dim Sl_Trebovnica As Recordset
  9.     Dim Usl_Pretrage As String, Nalog As String, Serija As String
  10.     Dim NalogSerija As String, Provjera As String, uBroj As String, Zadani As Long
  11.   '--------------------------------------------------
  12.     CurrentDb.Execute "DELETE*FROM [Trebovnica]"
  13.     CurrentDb.Execute "DELETE*FROM [ZbirnikKonacni]"
  14.    
  15. DoCmd.Hourglass True
  16.  
  17.              ' -----------------------------------------------------------
  18.       Shema  'Poziva se Funkcija SHEMA
  19.              '------------------------------------------------------------
  20.              
  21.         DoCmd.OpenQuery "ZbirnikQryApp", acNormal, acEdit     'Kopiranje iz    ZbirnikQry u tablicu ZbirnikKonacni
  22.         DoCmd.OpenQuery "ZbirnikPNDQryApp", acNormal, acEdit  'Kopiranje iz ZbirnikPNDQry u tablicu ZbirnikKonacni
  23.         DoCmd.OpenQuery "ZbirnikStrojPNDQryApp", acNormal, acEdit
  24.                
  25.     If IsNull([txtBrPrveTrebovnice]) Or [txtBrPrveTrebovnice] = 0 Then
  26.         MsgBox "Morate upisati po etni broj izdatnice", vbCritical, "Nedostaju podaci"
  27.         Me![txtBrPrveTrebovnice].SetFocus
  28.         GoTo Kraj
  29.     End If
  30.    
  31.     Zadani = Me.txtBrPrveTrebovnice
  32.    
  33.  DoCmd.OpenQuery "Izdatnica", acViewNormal, acEdit   'Kopiranje iz tablica ZbirnikKonacni+Proces u tablicu Trebovnica
  34.  
  35.     Set Baza = CurrentDb()
  36.     Set Sl_Trebovnica = Baza.OpenRecordset("Trebovnica", dbOpenDynaset)
  37.        '------------------------------------------------------
  38.        ' Upisivanje brojeva trebovnice u tablicu Trebovnica
  39.        '------------------------------------------------------
  40.     If Sl_Trebovnica.RecordCount > 0 Then
  41.         Sl_Trebovnica.MoveFirst
  42.         While Not Sl_Trebovnica.EOF
  43.             With Sl_Trebovnica
  44.                .Edit
  45.                ![BrIzdatnice] = Zadani
  46.                .Update
  47.             End With
  48.             Zadani = Zadani + 1
  49.             Sl_Trebovnica.MoveNext
  50.         Wend
  51.     Else
  52.         GoTo Kraj
  53.     End If
  54.     If MsgBox("ŽeliÅ¡ li arhivirati nalog", vbYesNo, "Gotov sam!") = vbYes Then 'POCETAK KOPIRANJA NALOGA
  55.     CurrentDb.Execute "DELETE*FROM DuplikatiNlg"
  56.     Set Baza = CurrentDb()
  57.     Set Sl_Zavrsna = Baza.OpenRecordset("ArhivaNalog", dbOpenDynaset)
  58.     Set Sl_ULAZNA = Baza.OpenRecordset("QryPrvaStrana", dbOpenDynaset)
  59.     Set Sl_Duplikati = Baza.OpenRecordset("DuplikatiNlg", dbOpenDynaset)
  60.         Nalog = Forms![PitaIzdatnicu].[RadniNalog]
  61.         Serija = Forms![PitaIzdatnicu].[Serija]
  62.         NalogSerija = Nalog & "/" & Serija
  63.  
  64. If Forms![PitaIzdatnicu].[Gotovo] = True Then
  65.     MsgBox "Ovaj nalog je ve lansiran", vbOKOnly
  66. GoTo Kraj
  67. End If
  68.     If Sl_ULAZNA.RecordCount > 0 Then
  69.        While Not Sl_ULAZNA.EOF
  70.         Provjera = Forms![PitaIzdatnicu].[NalogID] & Sl_ULAZNA![IDdijela]
  71.         uBroj = Provjera
  72.         Usl_Pretrage = ("SELECT * FROM ArhivaNalog WHERE NalogID & IDDijela ='" & uBroj & "'")
  73.         Set Sl_Pretrage = Baza.OpenRecordset(Usl_Pretrage, dbOpenDynaset)
  74.    If Sl_Pretrage.RecordCount = 0 Then
  75.             With Sl_Zavrsna
  76.                  .AddNew
  77.                  ![NalogID] = Forms![PitaIzdatnicu].[NalogID]
  78.                  ![Nalog] = NalogSerija
  79.                  ![IDStroja] = Sl_ULAZNA![IDStroja]
  80.                  ![BrojStroja] = Sl_ULAZNA![BrojStroja]
  81.                  ![NazivStr] = Sl_ULAZNA![NazivStr]
  82.                  ![NivoB] = Sl_ULAZNA![Nivo]
  83.                  ![IDdijela] = Sl_ULAZNA![IDdijela]
  84.                  ![Kom] = Sl_ULAZNA![SumOfBrKomadaSum]
  85.                  ![ZaIzraditi] = Forms![PitaIzdatnicu].[KOMADA] * Sl_ULAZNA![SumOfBrKomadaSum]
  86.                  .Update
  87.             End With
  88.           Else
  89.           With Sl_Duplikati
  90.                  .AddNew
  91.                  ![NalogID] = Forms![PitaIzdatnicu].[NalogID]
  92.                  ![Nalog] = NalogSerija
  93.                  ![IDStroja] = Sl_ULAZNA![IDStroja]
  94.                  ![BrojStroja] = Sl_ULAZNA![BrojStroja]
  95.                  ![NazivStr] = Sl_ULAZNA![NazivStr]
  96.                  ![IDdijela] = Sl_ULAZNA![IDdijela]
  97.                  ![Kom] = Sl_ULAZNA![SumOfBrKomadaSum]
  98.                  ![ZaIzraditi] = Forms![PitaIzdatnicu].[KOMADA] * Sl_ULAZNA![SumOfBrKomadaSum]
  99.                  .Update
  100.             End With
  101.             End If
  102.          Sl_ULAZNA.MoveNext
  103.         Wend
  104.     End If
  105.                       ' -----------------------------------------------------------
  106.    VrijednostNaloga   ' Poziva se funkcije zaupis vrijednosti naloga
  107.                       ' -----------------------------------------------------------
  108.     If Sl_Duplikati.RecordCount > 0 Then
  109.     If MsgBox("Podaci za ovaj nalog ve su arhivirani. Želite li ih pogledati", vbYesNo, "Dupli podaci!") = vbYes Then
  110.     DoCmd.OpenForm "frmArhivaNlg", acFormDS, , , acFormPropertySettings, acWindowNormal
  111.     DoCmd.OpenForm "frmDuplikatiNlg", acFormDS, , , acFormPropertySettings, acWindowNormal
  112.     Else
  113.         Me.Undo
  114.     End If
  115.     End If
  116.    Else
  117.                     ' -----------------------------------------------------------
  118.    VrijednostNaloga   ' Poziva se funkcije zaupis vrijednosti naloga
  119.                    ' -----------------------------------------------------------
  120.     Exit Sub
  121.     End If
  122. Kraj:
  123.     Set Baza = Nothing
  124. Exit_C_Slozi_Click:
  125.     Exit Sub
  126. Err_C_Slozi_Click:
  127.     MsgBox err.Description
  128.     Resume Exit_C_Slozi_Click
  129. End Sub
Pozdrav