Kreis einfärben - Flackern verhindern

Hallo Zusammen,
ich habe ein Kontrollkästchen (Formularsteuerelement) zusammengestellt, dass auf meiner _
Eingabeseite ausgeführt werden kann (


Sub Kreisfaerben()).
Bei Aktiviert soll auf Tabelle1 ein Kreis mit Haken eingefärbt werden. Ich möchte aber nicht in  _
_
_
Tabelle1 springen sondern auf meiner Eingabeseite bleiben. Das Ganze soll sozusagen im " _
Hintergrund" passieren.
Ich habe mir das Makro per Aufzeichnung zusammengestellt, es funktioniert auch aber es flackert  _
_
_
total. Kann ich in meinem Code etwas unnötiges herauslöschen, dass dem flackern entgegen wirken  _
_
könnte.
Mit "flackern" meine ich, dass man kurz in Tabelle1 springt und dem Makro sozusagen zugucken  _
kann. Ich weiß nicht wie man das in der Fachsprache bezeichnet ;).
Vielen Dank für eure Unterstützung.
Liebe Grüße
Meike

Sub Kreisfaerben()
If Worksheets("Eingabe").Range("Q37") = True Then
Call Tabelle1_Kreisrot
Else
Call Tabelle1_Kreisgrau
End If
End Sub

Sub  Tabelle1_Kreisrot()
Sheets("Tabelle1").Select
ActiveSheet.Unprotect Password:="pw"
ActiveSheet.Shapes.Range(Array("Group_K1")).Select
ActiveSheet.Shapes.Range(Array("K1_Haken")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(227, 6, 19)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("K1_Innenkreis")).Select
ActiveSheet.Shapes.Range(Array("K1_Haken")).Select
ActiveSheet.Shapes.Range(Array("K1_Innenkreis")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(227, 6, 19)
.Transparency = 0
.Solid
End With
Sheets("Tabelle1").Select
ActiveSheet.Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
Sheets("Eingabe").Select
End Sub

Sub Tabelle1_Kreisgrau()
Sheets("Tabelle1").Select
ActiveSheet.Unprotect Password:="pw"
ActiveSheet.Shapes.Range(Array("K1_Haken")).Select
ActiveSheet.Shapes.Range(Array("K1_Außenkreis")).Select
ActiveSheet.Shapes.Range(Array("K1_Innenkreis")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(120, 120, 120)
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("K1_Haken")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(120, 120, 120)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(120, 120, 120)
.Transparency = 0
.Solid
End With
Sheets("Tabelle1").Select
ActiveSheet.Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
Sheets("Eingabe").Select
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

die beste Methode ist, wie von Rudi gezeigt die zu bearbeitenden Objekte im Code direkt anzsprechen ohne sie vorher zu selektieren.
Bei Grafischen Objekten ist das aber nicht immer ganz einfach, wenn man auf dem Niveau "VBA nur mit Recorder" arbeitet, weil bei der direkten Ansprache in manchen Fällen eine andere Objektkette erforderlich ist als die Aufzeichnung des Recorders vorgibt.
in solchen Fällen kann man das Flackern damit vermeiden, dass man den Bildschirm für die Zeitdauer des Makrolaufs "einfriert", so dass dieser während des Makrolaufs nicht mehr aktualisiert wird und erst am Ende das fertige Ergebenis zeigt.
hierzu stellt man an den Anfang des Codes den Befehl:

Application.ScreenUpdating = False

und schaltet am Ende wieder ein (wobei das nicht zwingend erforderlich ist, weil Excel die Bildschirmaktualisierung bei Makroende automatisch einschaltet):

Application.ScreenUpdating = True

Gruss Daniel

Sub Tabelle1_Kreisrot() With Sheets("Tabelle1") .Unprotect Password:="pw" With .Shapes("K1_Haken") With .Fill .Visible = msoTrue .ForeColor.RGB = RGB(227, 6, 19) .Transparency = 0 .Solid End With With .TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 .ForeColor.TintAndShade = 0 '.ForeColor.Brightness = 0 .Transparency = 0 .Solid End With End With With .Shapes("K1_Innenkreis") With .Fill .Visible = msoTrue .ForeColor.RGB = RGB(227, 6, 19) .Transparency = 0 .Solid End With .Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True End With End With End Sub

Sub Tabelle1_Kreisrot() Application.ScreenUpdating = False With Sheets("Tabelle1") .Unprotect Password:="pw" With .Shapes("K1_Haken") With .Fill .Visible = msoTrue .ForeColor.RGB = RGB(227, 6, 19) .Transparency = 0 .Solid End With With .TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 .ForeColor.TintAndShade = 0 '.ForeColor.Brightness = 0 .Transparency = 0 .Solid End With End With With .Shapes("K1_Innenkreis") With .Fill .Visible = msoTrue .ForeColor.RGB = RGB(227, 6, 19) .Transparency = 0 .Solid End With .Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True End With End With End Sub

Beliebteste Forumthreads (12 Monate)

Kreis einfärben - Flackern verhindern

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kreis einfärben - Flackern verhindern

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread