Skapa en progressbar med VBA
Om man kör ett makro som tar lång tid att utföra kan det vara värt att visa användaren hur långt makrot kommit och hur långt man har kvar. I VBA finns ingen färdig formulärkontroll för detta, men med ett enkelt trick kan man skapa en själv.
Skapa formuläret
I formuläret där du har din progressbar lägga du två stycken etiketter ovanpå varandra. Den undre etiketten ska vi sätta en bakgrundsfärg och i den övre skriver vi en text. Den undre etiketten kommer att ändra storlek beroende på hur långt vi kommit. Från början är den 0 pixlar bred och sedan blir den allt bredare. Textetiketten har alltid samma storlek. Låt denna ha genomskinlig (transparent) bakgrund och ge den en tunn ram.
Jag har döpt mina etiketter till lblProgressBackground och lblProgressText.
Texten i etiketten har jag valt att ha "Arbetar - {0} % klart". Koden {0} kommer jag vid körning ersätta med procentsatsen för hur lång man kommit. Längden på den färglagda etiketten sätts till x procent av hela bredden.
Koden
Det första jag vill göra är att spara undan texten och bredden för etiketterna. Detta för att jag ska veta hur brett 100 % är samt mallen för texten, så det är enkelt att ersätta {0} med rätt procentsats.
Private Sub DoStuff()
Dim i As Long
Dim strProgressText As String
Dim lngProgressBackground As Long
Dim lngProgress As Long
Dim bFinished As Boolean
bFinished = False
i = 1
lngProgress = 0
strProgressText = lblProgressText.Caption
lngProgressBackground = lblProgressBackground.Width
Do While Not bFinished
‘ Kör kod för att göra det du ska och sätt
' bFinished = True när du är klar med allt
DoEvents
lngProgress = CInt((i / oFolder.Files.Count) * 100)
lblProgressText.Caption = Replace(strProgressText, "{0}", lngProgress)
lblProgressBackground.Width = CInt(lngProgress * (lngProgressWidth / 100))
i = i + 1
Loop
End Sub
Under tiden som din loop körs så sker två viktiga saker. DoEvents låter dialogrutan hinna uppdateras och ta emot eventuella knapptryck, t ex en Avbryt-knapp. Sedan räknar vi fram hur långt vi kommit och sparar detta i variabeln lngProgress. Etiketten med texten sätts till vår uppdaterade text där {0} ersätts med rätt siffra. Därefter sätts bredden på den färglagda etiketten till x procent av hela bredden.
Ett verkligt exempel
I nedanstående har jag gjort ett verkligt exempel som kopplar en vald mall till alla dokument i en viss mapp. För varje fil som är färdig uppdateras min progressbar.
Private Sub AttachTemplateToDocuments(ByVal strTemplate As String, ByVal strFolder As String)
Dim oFso As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim o
Mvh // Johan
Född vid 334.00 PPM
VAd synd att artikeln har blivit trasig. Ska se om jag hittar originalet någonstans.
Mvh // Johan
Född vid 334.00 PPM