VBA StatusBar - Kako omogućiti statusnu traku pomoću VBA koda?

Excel VBA Statusna traka

StatusBar je svojstvo vba koja se koristi za prikaz statusa koda završenog ili dovršenog u vrijeme izvršenja, prikazuje se u lijevom kutu radnog lista kada se izvrši makronaredba i status se prikazuje u postocima korisniku.

Kada makronarednik trči iza, frustrirajuće je čekati ne znajući koliko će vremena trebati. Ako ste u fazi u kojoj se kôd izvodi, možete barem izračunati vrijeme koje će mu trebati. Dakle, ideja je imati statusnu traku koja pokazuje postotak do sada obavljenog posla, poput donje.

Što je Application.StatusBar?

Application.StatusBar je svojstvo koje možemo koristiti u kodiranju makronaredbi da bismo prikazali status kada makronaredba radi iza scene.

Ovo nije tako lijepo kao naša "VBA Progress Bar", ali dovoljno dobro da se zna status makro projekta.

Primjer za stvaranje statusne trake pomoću VBA

Slijedite korake u nastavku za stvaranje trake stanja.

Korak 1: Prvo definirajte VBA varijablu kako biste pronašli zadnji korišteni redak na radnom listu.

Kodirati:

Sub Status_Bar_Progress () Zatamni LR kao duži kraj Sub

Korak 2: Pronađite zadnji korišteni redak pomoću donjeg koda.

Kodirati:

Sub Status_Bar_Progress () Dim LR Dugo LR = Ćelije (Redovi.broj, 1). Kraj (xlUp). Red Kraj Sub

Korak 3: Dalje, moramo definirati varijablu koja će sadržavati broj traka za prikaz.

Kodirati:

Sub Status_Bar_Progress () Dim LR as Long LR = Cells (Rows.Count, 1) .End (xlUp) .Rad Dim NumOfBars As Integer End Sub

Ovo će sadržavati koliko je traka dopušteno prikazati na statusnoj traci.

Korak 4: Za ovu varijablu spremite ograničenje trake kao 45.

Kodirati:

Sub Status_Bar_Progress () Dim LR as Long LR = Cells (Rows.Count, 1). End (xlUp). Red Dim NumOfBars As Integer NumOfBars = 45 End Sub

Korak 5: Definirajte još dvije varijable koje će zadržati trenutni status i postotak dovršene kada je makronaredba pokrenuta.

Kodirati:

Sub Status_Bar_Progress () Dim LR dokle god LR = Stanice (Redovi.broj, 1). Kraj (xlUp). Red Dim NumOfBars Kao cjeloviti NumOfBars = 45 Dim PresentStatus Kao cjeloviti Dim PercetageZavršeno kao Integer End Sub

6. korak: Da biste omogućili statusnu traku, upotrijebite donji kod.

Kodirati:

Sub Status_Bar_Progress () Dim LR dokle god LR = Stanice (Redovi.broj, 1). Kraj (xlUp). Red Dim NumOfBars Kao cjeloviti NumOfBars = 45 Dim PresentStatus Kao cjelovit Dim PercetageZavršeno kao cjelovita aplikacija.StatusBar = "(" & razmak ( NumOfBars) & ")" Kraj Sub

Što će to učiniti, dodat će zagradu (() i dodati 45 razmaka prije završetka teksta završnom zagradom ()).

Izvršite kôd i mogli bismo vidjeti dolje na traci statusa excela VBA.

Izlaz:

Korak 7: Sada u VBA moramo uključiti petlju For Next kako bismo izračunali postotak dovršene makronaredbe. Definirajte varijablu za pokretanje makronaredbe.

Kodirati:

Sub Status_Bar_Progress () Dim LR dokle god LR = Stanice (Redovi.broj, 1). Kraj (xlUp). Red Dim NumOfBars Kao cjeloviti NumOfBars = 45 Dim PresentStatus Kao cjelovit Dim PercetageZavršeno kao cjelovita aplikacija.StatusBar = "(" & razmak ( NumOfBars) & ")" Dim k Koliko dugo je k = 1 do LR Sljedeće k Kraj Sub

Korak 8: Unutar petlje moramo izračunati što je „Sadašnji status“. Dakle, za varijablu "PresentStatus" moramo primijeniti formulu kao u nastavku.

Kodirati:

Sub Status_Bar_Progress () Dim LR dokle god LR = Stanice (Redovi.broj, 1). Kraj (xlUp). Red Dim NumOfBars Kao cjeloviti NumOfBars = 45 Dim PresentStatus Kao cjelovit Dim PercetageZavršeno kao cjelovita aplikacija.StatusBar = "(" & razmak ( NumOfBars) & ")" Dim k Koliko dugo traje k = 1 do LR PresentStatus = Int ((k / LR) * NumOfBars) Sljedeći k Kraj Sub

Koristili smo funkciju " INT " da bismo kao rezultat dobili cijelu vrijednost.

Korak 9: Sada moramo izračunati što je „ Procentualno dovršenje “, tako da možemo primijeniti formulu kako je prikazano u nastavku.

Kodirati:

Sub Status_Bar_Progress () Dim LR dokle god LR = Stanice (Redovi.broj, 1). Kraj (xlUp). Red Dim NumOfBars Kao cjeloviti NumOfBars = 45 Dim PresentStatus Kao cjelovit Dim PercetageZavršeno kao cjelovita aplikacija.StatusBar = "(" & razmak ( NumOfBars) & ")" Dim k Koliko dugo traje k = 1 do LR PresentStatus = Int ((k / LR) * NumOfBars) PercetageCompleted = Round (PresentStatus / NumOfBars * 100, 0) Next k End Sub

U ovom smo slučaju koristili funkciju ROUND u excelu jer bez obzira na decimalna mjesta, moramo zaokružiti na najbližu nulu, pa je ovdje upotrijebljen ROUND s nulom.

Korak 10: Već smo umetnuli početnu i završnu zagradu na statusnu traku, sada moramo umetnuti ažurirani rezultat, a to se može učiniti pomoću donjeg koda.

Kodirati:

Sub Status_Bar_Progress () Dim LR Long LR = Cells (Rows.Count, 1) .End (xlUp) .Red Dim NumOfBars As Integer NumOfBars = 45 Dim PresentStatus As Integer Dim PercetageCompleted As Integer Application.StatusBar = "(" & Space ( NumOfBars) & ")" Dim k Koliko dugo traje k = 1 do LR PresentStatus = Int ((k / LR) * NumOfBars) PercetageCompleted = Round (PresentStatus / NumOfBars * 100, 0) Application.StatusBar = "(" & String ( PresentStatus, "|") & Space (NumOfBars - PresentStatus) & _ ")" & PercetageCompleted & "% Complete" Sljedeći k Kraj Sub

U gornji kôd umetnuli smo uvodnu zagradu “(“ i da bismo prikazali napredak makronaredbe, umetnuli smo ravnu crtu (|) pomoću funkcije STRING. Kada se petlja izvodi, zauzet će „ PresentStatus “ , ”I tih mnogo ravnih crta bit će umetnuto u statusnu traku.

Kodirati:

Application.StatusBar = "(" & Niz (PresentStatus, "|")

Dalje, trebamo dodati razmake između jedne ravne crte drugoj, pa će se to izračunati pomoću "NumOfBars" minus "PresentStatus".

Kodirati:

Application.StatusBar = "(" & String (PresentStatus, "|") & Space (NumOfBars - PresentStatus))

Zatim zatvorimo zagradu ")." Zatim smo kombinirali vrijednost varijable "PercentageCompleted" dok se petlja izvodi, a riječ ispred nje bila je "% Completed".

Kodirati:

Application.StatusBar = "(" & String(PresentStatus, "|") & Space(NumOfBars - PresentStatus)& _") " & PercetageCompleted & "% Complete"

When the code is running, we allow the user to access the worksheet, so we need to add “Do Events.”

Code:

Sub Status_Bar_Progress() Dim LR As Long LR = Cells(Rows.Count, 1).End(xlUp).Row Dim NumOfBars As Integer NumOfBars = 45 Dim PresentStatus As Integer Dim PercetageCompleted As Integer Application.StatusBar = "(" & Space(NumOfBars) & ")" Dim k As Long For k = 1 To LR PresentStatus = Int((k / LR) * NumOfBars) PercetageCompleted = Round(PresentStatus / NumOfBars * 100, 0) Application.StatusBar = "(" & String(PresentStatus, "|") & Space(NumOfBars - PresentStatus) & _ ") " & PercetageCompleted & "% Complete" DoEvents Next k End Sub

Step 11: After adding “Do Events,” we can write the codes that need to be executed here.

For example, I want to insert serial numbers to the cells, so I will write code as below.’

Code:

Sub Status_Bar_Progress() Dim LR As Long LR = Cells(Rows.Count, 1).End(xlUp).Row Dim NumOfBars As Integer NumOfBars = 45 Dim PresentStatus As Integer Dim PercetageCompleted As Integer Application.StatusBar = "(" & Space(NumOfBars) & ")" Dim k As Long For k = 1 To LR PresentStatus = Int((k / LR) * NumOfBars) PercetageCompleted = Round(PresentStatus / NumOfBars * 100, 0) Application.StatusBar = "(" & String(PresentStatus, "|") & Space(NumOfBars - PresentStatus) & _") " & PercetageCompleted & "% Complete" DoEvents Cells(k, 1).Value = k 'You can add your code here Next k End Sub

Step 12: Before we come out of the loop, we need to add one more thing, i.e., If the loop near the last used row in the worksheet then we need to make the status bar as normal.

Code:

Sub Status_Bar_Progress() Dim LR As Long LR = Cells(Rows.Count, 1).End(xlUp).Row Dim NumOfBars As Integer NumOfBars = 45 Dim PresentStatus As Integer Dim PercetageCompleted As Integer Application.StatusBar = "(" & Space(NumOfBars) & ")" Dim k As Long For k = 1 To LR PresentStatus = Int((k / LR) * NumOfBars) PercetageCompleted = Round(PresentStatus / NumOfBars * 100, 0) Application.StatusBar = "(" & String(PresentStatus, "|") & Space(NumOfBars - PresentStatus) & _") " & PercetageCompleted & "% Complete" DoEvents Cells(k, 1).Value = k 'You can add your code here 'You can Add your code here 'You can Add your code here 'You can add your code here 'You can add your code here 'You can add your code here If k = LR Then Application.StatusBar = False Next k End Sub

Ok, we are done with coding. As you execute the code here, you can see the status bar updating its percentage completion status.

Output:

Below is the code for you.

Code:

Sub Status_Bar_Progress() Dim LR As Long LR = Cells(Rows.Count, 1).End(xlUp).Row Dim NumOfBars As Integer NumOfBars = 45 Dim PresentStatus As Integer Dim PercetageCompleted As Integer Application.StatusBar = "(" & Space(NumOfBars) & ")" Dim k As Long For k = 1 To LR PresentStatus = Int((k / LR) * NumOfBars) PercetageCompleted = Round(PresentStatus / NumOfBars * 100, 0) Application.StatusBar = "(" & String(PresentStatus, "|") & Space(NumOfBars - PresentStatus) & _") " & PercetageCompleted & "% Complete" DoEvents Cells(k, 1).Value = k 'You can add your code here 'You can Add your code here 'You can Add your code here 'You can add your code here 'You can add your code here 'You can add your code here If k = LR Then Application.StatusBar = False Next k End Sub

Stvari koje treba zapamtiti

  • Možemo dodati samo zadatke koje treba obaviti unutar petlje.
  • Možete dodati zadatke koje trebate obaviti nakon dodavanja postupka "Događaji".

Zanimljivi članci...