Application.screenupdate werkt niet

Status
Niet open voor verdere reacties.

Karag68

Gebruiker
Lid geworden
25 jan 2008
Berichten
111
Ik heb een probleem waar ik gek van word.
Ik heb een sub geschreven die begint met Application.ScreenUpdating = False.
Als ik deze sub laat lopen werkt dit feilloos zonder flikkeren van het beeld.
Maar als ik deze sub via een Call aanroep flikkert het beeld wel meerdere malen.
Hoe kan dit???

Dit zijn de twee sub's die ik gebruik.
----------------------------------------------------------------
Private Sub CheckBox1_Click()
'Hiermee wordt de keuze gemaakt tussen 1 of 2 groepen

Call Update_namen
End Sub
----------------------------------------------------------------

Sub Update_namen()

Application.ScreenUpdating = False

'alle regels zichtbaar maken

Range("B9:B274,C9:C274,D9:D274,E9:E274").AutoFilter Field:=1

Range("A10:CD49,A55:CD94,A100:CD139,A145:CD184,A190:BW229,A234:AX273").Borders(xlInsideHorizontal).LineStyle = xlContinuous

'Verbergen van regels

Range("B9:B273").AutoFilter Field:=1, Criteria1:="<>"

If Range("DC20").Value = True Then
Range("30:49,75:94,120:139,165:184,210:229,254:273").EntireRow.Hidden = False
ActiveSheet.OptionButton10.Value = True
ActiveSheet.Shapes("Groep 2").Visible = True
Range("Z4").Font.ColorIndex = xlAutomatic
Else
ActiveSheet.OptionButton6.Value = True
Range("30:49,75:94,120:139,165:184,210:229,254:273").EntireRow.Hidden = True
ActiveSheet.Shapes("Groep 2").Visible = False
Range("Z4").Font.Color = RGB(216, 228, 188)
End If

'Onderkant kader toevoegen

Dim Streep1 As String
Streep1 = Range("CP6")
Range(Streep1).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep2 As String
Streep2 = Range("CP7")
Range(Streep2).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep3 As String
Streep3 = Range("CP8")
Range(Streep3).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep4 As String
Streep4 = Range("CP9")
Range(Streep4).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep5 As String
Streep5 = Range("CP10")
Range(Streep5).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep6 As String
Streep6 = Range("CP11")
Range(Streep6).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep7 As String
Streep7 = Range("CP13")
Range(Streep7).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep8 As String
Streep8 = Range("CP14")
Range(Streep8).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep9 As String
Streep9 = Range("CP15")
Range(Streep9).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep10 As String
Streep10 = Range("CP16")
Range(Streep10).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep11 As String
Streep11 = Range("CP17")
Range(Streep11).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep12 As String
Streep12 = Range("CP18")
Range(Streep12).Borders(xlEdgeBottom).Weight = xlMedium

Range("F10").Select

End Sub
 
Probeer het eens zo
(zet in het vervolg uw code tussen codeTags, nu is die zooi niet te lezen.)

Code:
Private Sub CheckBox1_Click()
'Hiermee wordt de keuze gemaakt tussen 1 of 2 groepen
[COLOR="#FF0000"]Application.ScreenUpdating = False.[/COLOR]
Call Update_namen
[COLOR="#FF0000"]Application.ScreenUpdating = True[/COLOR]
End Sub
en
Code:
Sub Update_namen()

Application.ScreenUpdating = False

'alle regels zichtbaar maken

Range("B9:B274,C9:C274,D9274,E9:E274").AutoFilter Field:=1

Range("A10:CD49,A55:CD94,A100:CD139,A145:CD184,A190:BW229,A234:AX273").Borders(xlInsideHorizontal).L ineStyle = xlContinuous

'Verbergen van regels

Range("B9:B273").AutoFilter Field:=1, Criteria1:="<>"

If Range("DC20").Value = True Then
Range("30:49,75:94,120:139,165:184,210:229,254:273").EntireRow.Hidden = False
ActiveSheet.OptionButton10.Value = True
ActiveSheet.Shapes("Groep 2").Visible = True
Range("Z4").Font.ColorIndex = xlAutomatic
Else
ActiveSheet.OptionButton6.Value = True
Range("30:49,75:94,120:139,165:184,210:229,254:273").EntireRow.Hidden = True
ActiveSheet.Shapes("Groep 2").Visible = False
Range("Z4").Font.Color = RGB(216, 228, 188)
End If

'Onderkant kader toevoegen

Dim Streep1 As String
Streep1 = Range("CP6")
Range(Streep1).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep2 As String
Streep2 = Range("CP7")
Range(Streep2).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep3 As String
Streep3 = Range("CP8")
Range(Streep3).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep4 As String
Streep4 = Range("CP9")
Range(Streep4).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep5 As String
Streep5 = Range("CP10")
Range(Streep5).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep6 As String
Streep6 = Range("CP11")
Range(Streep6).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep7 As String
Streep7 = Range("CP13")
Range(Streep7).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep8 As String
Streep8 = Range("CP14")
Range(Streep8).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep9 As String
Streep9 = Range("CP15")
Range(Streep9).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep10 As String
Streep10 = Range("CP16")
Range(Streep10).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep11 As String
Streep11 = Range("CP17")
Range(Streep11).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep12 As String
Streep12 = Range("CP18")
Range(Streep12).Borders(xlEdgeBottom).Weight = xlMedium

Range("F10").Select
[COLOR="#FF0000"]Application.ScreenUpdating = True[/COLOR]
End Sub
 
Als ik dit stuk code doorkauw

Code:
Dim Streep1 As String
Streep1 = Range("CP6")
Range(Streep1).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep2 As String
Streep2 = Range("CP7")
Range(Streep2).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep3 As String
Streep3 = Range("CP8")
Range(Streep3).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep4 As String
Streep4 = Range("CP9")
Range(Streep4).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep5 As String
Streep5 = Range("CP10")
Range(Streep5).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep6 As String
Streep6 = Range("CP11")
Range(Streep6).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep7 As String
Streep7 = Range("CP13")
Range(Streep7).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep8 As String
Streep8 = Range("CP14")
Range(Streep8).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep9 As String
Streep9 = Range("CP15")
Range(Streep9).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep10 As String
Streep10 = Range("CP16")
Range(Streep10).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep11 As String
Streep11 = Range("CP17")
Range(Streep11).Borders(xlEdgeBottom).Weight = xlMedium

Dim Streep12 As String
Streep12 = Range("CP18")
Range(Streep12).Borders(xlEdgeBottom).Weight = xlMedium

Range("F10").Select
Doet dit stukje net hetzelfde
Code:
Dim rCell As Range
Dim rRng As Range
Set rRng = Range("CP6:CP11,CP13:CP18")
For Each rCell In rRng.Cells
rCell.Borders(xlEdgeBottom).Weight = xlMedium
Next rCell
Range("F10").Activate
Probeer Select en Activate te vermijden in uw code
 
Verwijder iedere regel waarin 'select' of 'activate' staat.

Code:
Range("CP6:CP18").Borders(xlEdgeBottom).Weight = xlMedium
kan 36 regels code vervangen.

Een voorbeeldbestand zegt meer dan 50 uiteindelijk overbodige regels.
 
Laatst bewerkt:
@Snb Volgens code TS moet CP12 niet onderstreept worden;)
 
dan zet je die regel precies onder de mijne :D
 
Ik ben niet zo'n ervaren programmeur. Dus bedankt voor al jullie tips.

gast0660:
Ik heb die Application.ScreenUpdating regels ook al eens toegevoegd echter dit maakte geen verschil. Beeld bleef flikkeren

Jouw nieuw stukje code werkt niet echt. De cellen CP6:CP11 worden nu onderstreept terwijl in die cellen verwijzen naar dynamische ranges die onderstreept moeten worden.

Toch blijf ik het heel gek vinden dat op het moment dat ik via Call naar de betreffende Sub ga, dat dan Application.ScreenUpdating = False niet meer werkt???
 
Laatst bewerkt:
Zo zie je maar weer dat zonder een representatief vb bestandje het heel moeilijk is om de juiste oorzaak te vinden van een probleem.
Heb je Application.EnableEvents=False als eens getest? (niet vergeten terug op True te zetten)
 
Deze draad bevat al een overdosis verspilde moeite.
 
snb:
Jammer van jouw reactie. Niet iedereen is zo ervaren als jij dit bent.
Deze site is juist toch voor mensen die hulp nodig hebben van ervaren mensen??
Gelukkig zijn er wel nog anderen die wel de moeite nemen om anderen te helpen.

gast0660,
Bedankt voor jouw moeite. Met je laatste tip heb je mij inderdaad geholpen.
Probleem opgelost.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan