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, które możemy sprawdzić też tak ob.GetExtensionName(plik)
    ProgressBar1.Value = r 'przekazujemy kolejny parametr
    r = r + 1
    ActiveWorkbook.Close False 'wychodzimy bez zapisu
    If r = 10 Then GoTo przerwij 'albo Exit For jako dupochron
  End If
 Next plik
przerwij:
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 .EnableEvents = True
End With

Set ob = Nothing 'można też spotkać opinie że zerowanie obiektów nie jest konieczne
Set folder = Nothing
Set pliki = Nothing
End Sub

 

Taką metodę można zastosować w Excelu, Outlooku, jak i w innych aplikacjach pakietu Office. Opis innych kontrolek i przykłady ich zastosowania znajdziesz tutaj.

 

(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

Ostatnio zalogowani:

Profile picture of vbatools
Profile picture of marcinmachalowski
Profile picture of Anorak
Profile picture of Joanna Subik
Profile picture of Karol Stilger
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