VBATools

Jak działa Progressbar

by on Feb.19, 2012, under Excel, Porady

Ten prosty przykład uzmysłowi wam jak działa pasek postępu. Elementarnym czynnikiem jest określenie wartości maksymalnej dla paska. W czasie przekazywania kolejnych parametrów, wartość paska będzie “dochodzić” do tej wartości.

Poniżej można znaleźć kod, który otwiera w zadeklarowanym katalogu pliki jakie spełniają określony warunek. Użyta w kodzie metoda FSO pozwala na przekazanie nazwy kolejnego pliku w pętli. Pliki są otwierane i zamykane bez zapisu. Parametr .value jest przekazywany.

Oto prosty przykład jak działa pasek postępu.

XL_Progressbar

rys 1. Pasek postępu przypisany do otwieranych kolejno plików.

 

Option Explicit
Private Sub UserForm_Initialize()
'Taki sposób nie jest dobry ponieważ kod zacznie działać zanim forma się wyświetli
'Call test_4progres
End Sub

Private Sub CommandButton1_Click()
'to jest dobry sposób - wymuszenie przyciskiem
Call test_4progres
End Sub

Private Sub UserForm_Activate()
'to jest dobry sposób - zadziała zaraz po wywołaniu formy
Call test_4progres
End Sub

Sub test_4progres()
'MVP OShon from VBATools.pl
Const sciezka$ = "C:\Temp"
Dim ob As Object, pliki As Object, plik As Object
Dim folder As Object, r&

Set ob = CreateObject("Scripting.FilesystemObject")
Set folder = ob.GetFolder(sciezka)
Set pliki = ob.GetFolder(folder).Files

ProgressBar1.Value = 0 'zerujemy pasek
ProgressBar1.Max = 9   'określamy maximum postępu, a może być też wyliczony pliki.count 

With Application
 .ScreenUpdating = False
 .EnableEvents = False
 .Calculation = xlCalculationManual
 .DisplayAlerts = False
 For Each plik In pliki
  DoEvents 'kluczowy parametr dzięki któremu będziemy widzieć postęp paska
  If Mid(LCase(plik), InStrRev(plik, ".") + 1, 3) = "xls" Then
    Workbooks.Open Filename:=(sciezka & plik.Name) 'otwieramy tylko pliki XLS
    ProgressBar1.Value = r 'przekazujemy kolejny parametr
    r = r + 1
    ActiveWorkbook.Close False
    If r = 10 Then GoTo przerwij
  End If
 Next plik
przerwij:
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 .EnableEvents = True
End With

Set ob = Nothing
Set folder = Nothing
Set pliki = Nothing
End Sub

 

Taką metodę można zastosować w Excelu, Outlooku, jak i w innych aplikacjach pakietu Office.

 

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

:, , , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała