add a bevelled 3D rectangle

On my sheets for students I like to add my top tips in a golden-yellow shape that stands out from the paper:

Anything in the golden 3D rectangle stands out to the student, but it is also separate from the Chemistry so doesn’t distract from it.

Making a rectangle then adding the bevelling requires a lot of clicks so I used to copy the rectangle from another document. But now I have a symbol on the Quick Access Toolbar so that one click gives me the bevelled golden rectangle with some sample text inside, in Arial font 11 justified with single line spacing:

The code below will add such a rectangle to your resources:

Sub DrawRectangle()
Dim Shp As Shape, sngTop As Single, sngLeft As Single
With Selection.Characters
sngTop = .First.Information(wdVerticalPositionRelativeToPage) – 12
sngLeft = .First.Information(wdHorizontalPositionRelativeToPage)
End With
Set Shp = ActiveDocument.Shapes.AddShape(Type:=5, Left:=sngLeft, Top:=sngTop, Width:=72, Height:=36)
With Shp
.Fill.ForeColor.RGB = RGB(255, 230, 153)
.TextFrame.TextRange.Text = “some text”
.TextFrame.TextRange.Font.Size = 11
.TextFrame.TextRange.Font.Name = “Arial”
.TextFrame.TextRange.Font.Color = Black
.ThreeD.BevelTopType = msoBevelCoolSlant
With .Line
.ForeColor.RGB = RGB(255, 217, 102)
.ForeColor.TintAndShade = 0#
.Visible = msoTrue
.Weight = 2.25
.Style = msoLineSingle
End With
End Sub

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: