16. marts 2005 - 11:13Der er
32 kommentarer og 1 løsning
Langsom makro !
Jeg har et problem med en meget ofte benyttet makro som opfører sig underligt. Ideen med makroen er at fjerne rækker fra en rapport hvor saldi giver nul og derefter udskrive udskriften. Makroen fungere f.s.v. udmærket første gang den bliver aktiveret, men anden gang "hænger" den og er ualmindelig lang tid om udførelsen. Lukker man derimod filen og åbner den igen er makroen igen kvik, men det virker utroligt irriterende.
Har nogen evt. et bud på hvad der kan være galt...jeg vedlægger koden :
Sub udskrivresultatudennul()
Sheets("RESULTATOPGØRELSE").Select application.ScreenUpdating = False application.Calculation = xlCalculationManual ActiveSheet.Outline.ShowLevels RowLevels:=2 For i = 3 To 1000 If Range("a" & i & ":a" & i + 3).Text = "" Then Exit For If application.WorksheetFunction.Sum(Range("b" & i & ":ao" & i)) = "0" Then Range(i & ":" & i).EntireRow.Hidden = True End If Next ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Range("3:1000").EntireRow.Hidden = False application.ScreenUpdating = True ActiveSheet.Outline.ShowLevels RowLevels:=1 Range("A1").Select application.Calculation = xlCalculationAutomatic Sheets("Valg").Select Range("A1").Select End Sub
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
Cells.EntireRow.Hidden = False ' viser rækkerne igen, hvis de var skjulte
application.Calculation = xlCalculationManual ActiveSheet.Outline.ShowLevels RowLevels:=2 For i = 3 To 1000 If Range("a" & i & ":a" & i + 3).Text = "" Then Exit For If application.WorksheetFunction.Sum(Range("b" & i & ":ao" & i)) = "0" Then Range(i & ":" & i).EntireRow.Hidden = True End If Next ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Range("3:1000").EntireRow.Hidden = False application.ScreenUpdating = True ActiveSheet.Outline.ShowLevels RowLevels:=1 Range("A1").Select application.Calculation = xlCalculationAutomatic Sheets("Valg").Select Range("A1").Select End Sub
Har moslet lidt rundt på koden og bl.a. erstattet Range med Rows, men ved ikke om det giver nogen forskel.
Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Sheets("RESULTATOPGØRELSE").Select ActiveSheet.Outline.ShowLevels RowLevels:=2 For i = 3 To 1000 If Range("a" & i & ":a" & i + 3).Text = "" Then Exit For If Application.WorksheetFunction.Sum(Range("b" & i & ":ao" & i)) = "0" Then Rows(i).EntireRow.Hidden = True End If Next ActiveSheet.PrintOut Rows("3:1000").EntireRow.Hidden = False ActiveSheet.Outline.ShowLevels RowLevels:=1 Sheets("Valg").Select Range("A1").Select Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = False
Da programmet så har fat i egenskaben hidden for hver række, kan det godt tænkes at koden måske bliver langsommere. Det må du jo lige prøve dig frem med.
Hvis jeg deler makroen i 2....del 1: gem alle nul rækker....del 2: vis alle rækker igen og helt udelader print....så kører det som en leg. Så snart jeg bringer et printlelement indover (også "vis på skærm") så går det galt.
Det er jo ikke så elegant,og super irriterende, for vi taler om en hel del filer....men.....hvis jeg opretter et print ark og kører makroen således
fjern nul rækker kopier ark indsæt i printark print printark tilbage til original ark vis alle rækker
ja....så kører det upåklageligt
men det er godt nok noget af en omvej...og frygtelig irriterende at skulle rette samtlige filer til på denne måde....men det kan jo ende med at blive løsningen.
Endnu et skud. I anden sammenhæng har jeg set, at der kan opstå problemer hvis f.eks. en kommandoknap eller lignende har focus. I det følgende har jeg derfor indsat en Range("A1").Select inden løkken. Måske skal den først stå efter løkken men før PrintOut - så du må prøve dig lidt frem.
Jeg må tilstå at jeg tvivler, men det er vel forholdsvis nemt for dig at prøve det.
Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Sheets("RESULTATOPGØRELSE").Select Range("A1").Select ActiveSheet.Outline.ShowLevels RowLevels:=2 For i = 3 To 1000 If Range("a" & i & ":a" & i + 3).Text = "" Then Exit For If Application.WorksheetFunction.Sum(Range("b" & i & ":ao" & i)) = "0" Then Rows(i).EntireRow.Hidden = True End If Next ActiveSheet.PrintOut Rows("3:1000").EntireRow.Hidden = False ActiveSheet.Outline.ShowLevels RowLevels:=1 Sheets("Valg").Select Range("A1").Select Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = False
Ja, printeren er ikke problemet....det giver således samme problem blot ved visning af print på skærm. Jeg har haft problemet i flere år...og jeg syntes jeg har prøvet ALT. Jeg har endog præsenteret problemet her på Eksperten for nogle år siden, uden megen held...http://www.eksperten.dk/spm/87133....dengang endte vi ud i en lang makro, temmelig kompliceret løsning, og også dengang med at kopiere over i et nyt ark og så udskrive herfra, en løsning jeg hurtigt droppede. Jeg håbede nu at nogle friske øjne måske kunne klare opgaven dennegang....men der er vist ikke rigtig noget at gøre ved det.
Hvis problemet for printet er de skjulte rækker, og det kan løses ved ikke at lave skjulte rækker, så er der vel ikke noget i vej for at man f.eks. gør således
- lav en kopi af RESULTATOPGØRELSE - kør ovenstående makro på kopien, men slet rækker i stedet for at skjule - slet kopien
Det sker altsammen med Application.ScreenUpdating = False, så man kan ikke se alt det "uhyggelige", der sker bag kulisserne.
Hvis tiden er et problem, synes jeg du skulle overveje det.
nej det dur ikke, vi går tilbage til makroen, men du skal stadigvæk gøre dette -------------------------------------- Prøv med Filter i AP3 sætter du formlen =SUM(B3:AO3) træk den ned til række 1000
Hold fast.....det kører som lyn og torden...kabbak.....det er på nippet til at være genialt !!! det var aldrig faldet mig ind at benytte Filter funktionen i en makro, men...selvfølgelig !!! Jeg bukker mig i støvet og takker !!! Sender du et svar, så kvitterer jeg med points.
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.
