Add text to a rectangle in VBA

  • Thread starter Thread starter pk
  • Start date Start date
P

pk

Please help!

Using VBA in XP with Win 2000;

I am trying to create a rectangle in VBA on a spreadsheet
and add some custom text, say 5 rows.

I want to turn the text -90 degrees (so it reads bottom to
top on its side), and single underline the first row and
the last row of text.

Note: that I must use a rectangle and NOT a text box.

I can add a rectangle in VBA, but that is where it stops.
I can't seem to even get text in the box...your example
code is what I need the most. Thanks in advance...
 
Sub Macro6()

ActiveSheet.Shapes.AddShape( _
msoShapeRectangle, 57.75, 775.5, _
81.75, 50.25). _
Select
Selection.Characters.Text = _
"abcdefgh" & Chr(10) & "ijklmnopqr" & _
Chr(10) & "stuvwxyz"
With Selection.Characters( _
Start:=1, Length:=8).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = xlAutomatic
End With
With Selection.Characters( _
Start:=19, Length:=10).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = xlAutomatic
End With

With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Orientation = xlUpward
.AutoSize = False
End With
End Sub
 
This works in xl97. Note that the vbLf code used to start
a new line apparently is treated as a character itself.
So when referencing characters you need to take this into
account. I've made a space between each line of text by
using an extra "vbLf".

Sub FormatRect()
Dim Rect As Shape
Set Rect = ActiveSheet.Shapes. _
AddShape(msoShapeRectangle, 70, 70, 100, 50)
With Rect.TextFrame
..Characters.Text = "ABCDE" & vbLf & vbLf & _
"FGHIJ" & vbLf & vbLf & "KLMNO" & vbLf & vbLf & _
"PQRST" & vbLf & vbLf & "UVWXY"
..Characters(1, 5).Font.Underline = xlUnderlineStyleSingle
..Characters(29, 5).Font.Underline = xlUnderlineStyleSingle
..Characters.Font.ColorIndex = 3
..Characters.Font.Name = "Arial"
..Characters.Font.FontStyle = "Bold Italic"
..Orientation = 2
End With
Rect.Select

End Sub

Hope it does the trick.

Regards,
Greg
 
Back
Top