07. januar 2011 - 15:43Der er
5 kommentarer og 1 løsning
Afvikle flere Do...Loop samtidig?
Jeg har brug for at kunne afvikle 2 forskellige Do...Loop samtidig i Visual Basic.
Jeg har lavet følgende 2 loops (begge fungerer - hver for sig): Det ene loop kan deaktivere X'et i højre hjørne af en userform. Det andet loop driver en progress bar i samme userform.
Jeg har lavet en makro som udfører en masse formateringer på et Exceldokument. Dokumentet er opdelt i 7 ark, som formatteres og gemmes som individuelle filer. Når makroen kører præsenteres brugeren for en userform, hvori han vha. checkbokse vælger hvilke af disse ark der skal behandles, og om de skal udskrives efter formatteringen. Derefter fortsætter makroen med at formattere de valgte ark mens en venteboks (userform med en "vent venligst..." tekst) vises (makroen kører i baggrunden vha. vbModeless og DoEvents).
Denne venteboks er udstyret med en progress bar, som opdateres vha. en variabel, der vokser med 1 hver gang makroen er færdig med at formattere et ark. Samtidig er X'et i højre hjørne deaktiveret, så brugeren ikke kan lukke userformen ned.
Indtil videre kan jeg vise venteboksen med deaktiveret kryds, mens makroen fortsat kører. Men så snart jeg smider progress bar-loopet på standser min makro.
Er der nogen der har en idé til hvordan jeg kan afvikle begge loops SAMTIDIG med at min makro kører videre i baggrunden?
Det var også min første indskydelse, men det virker ikke, da de to loop har forskellige betingelser. Og lægger jeg dem inden i hinanden standser det inderste loop det yderste, indtil det inderste er kørt færdig. I begge tilfælde standser det min bagvedkørende makro...
@tjp: Ja, det kunne man, hvis det ikke var fordi det første loop afsluttes så snart userformen vises på skærmen.
Måske det er nemmere hvis jeg poster koden for userformen (KørerForm). Variablerne Udført og Teams er defineret i toppen af makroen, vha. Public, og er begge defineret som Integer. Udført er den variabel som øges med 1 hver gang et ark (Team) er færdigformatteret. Teams er det samlede antal ark der er valgt til formattering i den indledende userform.
I øjeblikket fungerer det sidste loop ikke, hvorfor userformen crasher.
---- Option Explicit
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Const MF_BYPOSITION = &H400&
Private Sub UserForm_Activate() Application.Cursor = xlWait KørerForm.MousePointer = fmMousePointerHourGlass DoEvents Call CalculateData End Sub
' Følgende deaktiverer krydset i øverste højre hjørne: Dim lHwnd As Long lHwnd = FindWindow("ThunderDFrame", "Vent...")
Do While lHwnd = 0 lHwnd = FindWindow("ThunderDFrame", "Vent...") DoEvents Loop RemoveMenu GetSystemMenu(lHwnd, 0), 6, MF_BYPOSITION
End Sub
Sub CalculateData() ' Driver progress baren: Dim x As Long x = 0
Do Until x = Teams x = Udført KørerForm.ProgressBar.Width = (Udført / Teams) * 200 KørerForm.ProgressText.Caption = "Udført: " & Udført & " af " & Teams DoEvents Loop
Hovsa, den sidste løkke skal selvfølgelig se således ud, hvorefter den fungerer - men kun når userformen køres isoleret. Når den startes fra makroen virker det ikke, og makroen standser:
Dim x As Long x = 0
Do Until x = Teams x = Udført KørerForm.ProgressBar.Width = (x / Teams) * 200 KørerForm.ProgressText.Caption = "Udført: " & x & " af " & Teams DoEvents Loop
KørerForm.ProgressBar.Width og KørerForm.ProgressText.Caption viste sig at kunne opdateres direkte fra selve makroen, når bare jeg indsatte en DoEvents efter kaldet af venteboksen. Derefter kunne jeg indføre alle de opdateringer af de to værdier jeg havde lyst til i selve makroen. Værdierne opdateres så automatisk når makroen når dertil...
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
