Microsoft Office

Skapa en progressbar med VBA

2006-03-18 20:57 #0 av: johan

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.

En progressbar skapad i VBA

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

Anmäl
2006-04-09 00:32 #1 av: johan

VAd synd att artikeln har blivit trasig. Ska se om jag hittar originalet någonstans.

Anmäl

Bli medlem på iFokus

För att kunna delta i diskussionen måste du bli medlem på iFokus. Det går snabbt, enkelt, och kostar ingenting. Medlemskapet ger dig tillgång till över 300 sajter.