Makro soll nicht aus der Zelle springen
17.07.2004 21:36:31
Andi
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