B
Bob
I have written some code that allow me to display a rectangle around
certain scores within my worksheet. My code fomats the rectangle with
black lines if a specific condition is met and with transparent lines
if the condition is not met. My problem is I have about 50 rectangles
within my work sheet and the code I have written address each
rectangel indvidually. I would appreciate it if someone could offer a
suggesting on improving the code. Thanks in advance
'Code for 2 of the 50 rectangles
Sub Insert_Box136()
Sheets("T7").Select
If Range("R8").Value = 0 Then
'Turn rectangle off
ActiveSheet.Shapes("Rectangle 136").Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 1.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
End If
If Range("R8").Value = 1 Then
'Turn rectangle on
ActiveSheet.Shapes("Rectangle 136").Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 1.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End If
End Sub
Sub Insert_Box137()
'
If Range("R9").Value = 0 Then
'Turn Box off
ActiveSheet.Shapes("Rectangle 137").Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 1.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
End If
If Range("R9").Value = 1 Then
'Turn rectangle on
ActiveSheet.Shapes("Rectangle 137").Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 1.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End If
End Sub
certain scores within my worksheet. My code fomats the rectangle with
black lines if a specific condition is met and with transparent lines
if the condition is not met. My problem is I have about 50 rectangles
within my work sheet and the code I have written address each
rectangel indvidually. I would appreciate it if someone could offer a
suggesting on improving the code. Thanks in advance
'Code for 2 of the 50 rectangles
Sub Insert_Box136()
Sheets("T7").Select
If Range("R8").Value = 0 Then
'Turn rectangle off
ActiveSheet.Shapes("Rectangle 136").Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 1.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
End If
If Range("R8").Value = 1 Then
'Turn rectangle on
ActiveSheet.Shapes("Rectangle 136").Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 1.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End If
End Sub
Sub Insert_Box137()
'
If Range("R9").Value = 0 Then
'Turn Box off
ActiveSheet.Shapes("Rectangle 137").Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 1.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
End If
If Range("R9").Value = 1 Then
'Turn rectangle on
ActiveSheet.Shapes("Rectangle 137").Select
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0.5
Selection.ShapeRange.Line.Weight = 1.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
End If
End Sub