Farben und Muster zuweisen

Bild

Betrifft: Farben und Muster zuweisen von: Tinu
Geschrieben am: 04.04.2005 20:48:27

Liebe VBA Spezialisten

Ich habe mir mit meinen bescheidenen VBA-Kenntnissen ein Excel-Sheet gebastelt, welches 8 verschiedene Farben und Muster zuweisen kann. Es klappt auch alles bestens, bis ich mehrere Zellen gleichzeitig verändere (z.B: mehrere Felder löschen, Felder "ziehen"). Dann stürzt das Programm ab.

https://www.herber.de/bbs/user/20690.xls

Was muss ich ändern?

besten Dank für Euere Hilfe
Tinu

Bild


Betrifft: AW: Farben und Muster zuweisen von: Uduuh
Geschrieben am: 04.04.2005 23:52:38

Hallo,
schon sehr schön. Vermeide diese If..If..If Konstruktionen. Select Case ist erheblich besser und übersichtlicher.
Der Fehler liegt darin, dass beim Ziehen und Mehrfachmarkierungen Target mehrere Zellen umfasst. Die musst du einzeln abfragen. Weiterhin verursacht dein Makro Änderungen, die wiederum das Makro auslösen. Also erstmal die Ereignisse abschalten.

Private Sub Worksheet_change(ByVal Target As Excel.Range)
  Dim EBereich As Range, rngC As Range
  Set EBereich = Range("A1:H50")
  If Intersect(Target, EBereich) Is Nothing Then Exit Sub
  On Error GoTo ErrHandler
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With
  For Each rngC In Target.Cells
    With rngC
      Select Case c.Value
        Case ""
          .Interior.ColorIndex = 0
          .Interior.Pattern = 0
          .Interior.PatternColorIndex = 41
        Case 0.1
          .Interior.ColorIndex = 0
          .Interior.Pattern = xlGray16
          .Interior.PatternColorIndex = 41
        Case 0.25
          .Interior.ColorIndex = 0
          .Interior.Pattern = xlLightUp
          .Interior.PatternColorIndex = 41
        Case 0.5
          .Interior.ColorIndex = 0
          .Interior.Pattern = xlUp
          .Interior.PatternColorIndex = 41
        Case 0.75
          .Interior.ColorIndex = 0
          .Interior.Pattern = xlChecker
          .Interior.PatternColorIndex = 41
        Case 0.9
          .Interior.ColorIndex = 0
          .Interior.Pattern = xlSemiGray75
          .Interior.PatternColorIndex = 41
        Case 1
          .Interior.ColorIndex = 41
          .Interior.Pattern = xlSolid
        Case 2
          .Interior.ColorIndex = 22
          .Interior.Pattern = xlSolid
        Case 3
          .Interior.ColorIndex = 3
          .Interior.Pattern = xlSolid
      End Select
    End With
  Next rngC
ErrHandler:
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With
End Sub

Gruß aus'm Pott
Udo



Bild


Betrifft: AW: Farben und Muster zuweisen von: Tinu
Geschrieben am: 05.04.2005 00:24:32

Hallo Udo

besten Dank für Deine Antwort. Scheinbar mache ich aber noch etwas falsch. Ich habe Deinen Code in mein Worksheet hineinkopiert, aber es tut sich nichts, wenn ich Daten eingebe. Die Zahlen erscheinen zwar, aber keine Farben oder Muster.

Gruss
Tinu


Bild


Betrifft: AW: Farben und Muster zuweisen von: u_
Geschrieben am: 05.04.2005 08:36:44

Hallo,
kleiner aber verheerender Fehler.
Korrigiere:
Select Case rngC.Value

Gruß


Bild


Betrifft: AW: Farben und Muster zuweisen von: Tinu
Geschrieben am: 05.04.2005 09:32:56

Super Udo! Jetzt läuft alles wie gewünscht. Nochmals herzlichen Dank!

Gruss
Tinu


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Farben und Muster zuweisen"