Makro verändert Textfeldfarbe nach Formelergebnis
17.07.2004 19:35:16
poleposition
Die Makros will ich gern so hinbekommen, dass sie komplett im Hintergrund laufen und nicht von der Zelle rausspringen in der ich mich gerade befinde.
Das zweite Problem ist, dass ich dieses Makro ACHT mal brauche für 8 Spiele, wo der Sieger ermittelt wird. Da haperts bei mir.
Hier mein Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("N43") = "Mannschaft 1" Then
Call sieger1_hervorheben
Else
Call sieger2_hervorheben
End If
End Sub
Sub sieger1_hervorheben()
ActiveSheet.Shapes("Text Box 180").Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 53
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1
ActiveSheet.Shapes("Text Box 179").Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 48
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1
End Sub
Sub sieger2_hervorheben()
ActiveSheet.Shapes("Text Box 179").Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 53
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1
ActiveSheet.Shapes("Text Box 180").Select
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 48
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 1
End Sub