Kreis einfärben - Flackern verhindern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Frame TextBox
Bild

Betrifft: Kreis einfärben - Flackern verhindern
von: Meike
Geschrieben am: 04.12.2015 12:01:23

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

Bild

Betrifft: Beispieldatei?
von: Michael
Geschrieben am: 04.12.2015 12:23:18


Hallo Meike,
Dein Code kann deutlich verbessert werden, aber zum Testen wäre eine Beispieldatei hilfreich, damit wir keine Grafiken/Textboxen basteln müssen.
Schöne Grüße,
Michael

Bild

Betrifft: AW: Beispieldatei?
von: Meike
Geschrieben am: 04.12.2015 12:46:21
Danke Michael für deine Antwort.
Anbei meine Beispieldatei.
https://www.herber.de/bbs/user/102011.xlsm
LG

Bild

Betrifft: AW: Beispieldatei?
von: Daniel
Geschrieben am: 04.12.2015 13:09:11
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

Bild

Betrifft: AW: Kreis einfärben - Flackern verhindern
von: Rudi Maintaire
Geschrieben am: 04.12.2015 12:35:20
Hallo,
das verhinderst du durch den konsequenten Verzicht auf Select.

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
Gruß
Rudi

Bild

Betrifft: AW: Kreis einfärben - Flackern verhindern
von: Meike
Geschrieben am: 04.12.2015 13:02:07
Danke Rudi.
Habe deine Verbesserung durchgeführt. Nur leider läuft es noch nicht ganz sauber. Wenn ich den Code durchführe meckert er bei:
.Protect Password:="pw", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
Wenn der Blattschutz wieder gesetzt werden soll.
Hast du noch eine Idee woran das liegen könnte?
LG

Bild

Betrifft: AW: Kreis einfärben - Flackern verhindern
von: Rudi Maintaire
Geschrieben am: 04.12.2015 13:20:40
Hallo,
entferne den _ und den Zeilenumbruch.
Gruß
Rudi

Bild

Betrifft: was vergessen.
von: Rudi Maintaire
Geschrieben am: 04.12.2015 13:02:03


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


Bild

Betrifft: AW: was vergessen.
von: Meike
Geschrieben am: 04.12.2015 14:26:49
Jungs, ich mache immer noch irgendetwas falsch :/
Ich habe _ und den Zeilenumbruch gelöscht und (Rudi)deinen verbesserten Code eingefügt.
Fehlermeldung immer noch bei .Protect.......
Hab die angepasste Datei nochmal angehängt.
Danke für eure Hilfe!!
https://www.herber.de/bbs/user/102013.xlsm

Bild

Betrifft: AW: was vergessen.
von: Meike
Geschrieben am: 04.12.2015 15:17:14
Habs selber heraus gefunden. Ich musste ein "End With" über den Blattschutz-Code setzen.
Jetzt gibts kein geflacker mehr =)
Danke euch.

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Kreis einfärben - Flackern verhindern"