Can some simplify this code?..

[DUI]

I have attached code to some Text Boxes that, when run, changes the colour and style of each box...(to make it look like buttons being pressed)

I created the code by recording the macro while formatting the boxes...

surely there's a better code out there somewhere?



Sub AdminButton_Click()

'Change Buttons
ActiveSheet.Shapes("Text Box 4604").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 56
End With
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 1.5
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 = 22
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 1

ActiveSheet.Shapes("Text Box 442").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 55
End With
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.25
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 = 22
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 1

ActiveSheet.Shapes("Text Box 443").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 55
End With
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.25
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 = 22
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 1

End Sub

 

[xld]

Sub AdminButton_Click()
'Change Buttons

    FormatShape ActiveSheet.Shapes("Text Box 4604")

    FormatShape ActiveSheet.Shapes("Text Box 442")

    FormatShape ActiveSheet.Shapes("Text Box 443")
End Sub

Private Sub FormatShape(Shp As Object)
    Shp.Select
    
    With Selection
        With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 55
        End With
        
        .ShapeRange.Fill.Transparency = 0#
        .ShapeRange.Line.Weight = 0.25
        .ShapeRange.Line.DashStyle = msoLineSolid
        .ShapeRange.Line.Style = msoLineSingle
        .ShapeRange.Line.Transparency = 0#
        .ShapeRange.Line.Visible = msoTrue
        .ShapeRange.Line.ForeColor.SchemeColor = 22
        .ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
        .ShapeRange.Fill.Visible = msoTrue
        .ShapeRange.Fill.ForeColor.SchemeColor = 44
        .ShapeRange.Fill.BackColor.SchemeColor = 9
        .ShapeRange.Fill.TwoColorGradient msoGradientHorizontal, 1
    End With
End Sub