View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.misc
Hugo Jorgensen Hugo Jorgensen is offline
external usenet poster
 
Posts: 2
Default Add and edit a shape in VBA

Hi, I have written code to add a rectangle and a line in VBA. When I run the
code it sometimes works fine. If I use F8 to step through the code the code
to add the line works fine but not if I run the code as usual.

The problem with the rectangle is that the text is not inserted into the
rectangle. What is wrong with the code?

Sub Shapes()
Dim Comment As String
Dim Serie_no
Dim Point_no
Dim Left__no
Dim Top_no

Serie_no = 3
Point_no = 3
' Text from a name range
Comment = Range("Comment_txt")
Sheets("Chart").Select
Set myDocument = Sheets("Chart")
' Delete existing shapes
For I = 1 To 20
On Error Resume Next
myDocument.Shapes(I).Delete
Next

'Add a new shape with text
With myDocument.Shapes.AddShape(msoShapeRectangle, _
100, 25, 300, 25) '- left, top width, height
.Name = "Info"
.Fill.ForeColor.RGB = RGB(0, 200, 250)
.Line.DashStyle = msoLineDashDot
.Text = Comment
.Font.Bold = True
.Font.Size = 18
End With
' Check the position of the label to be used as reference for the line
With myDocument.SeriesCollection(Serie_no).Points(Point _no)
.HasDataLabel = False
.HasDataLabel = True
.ApplyDataLabels Type:=xlValue
End With
Left__no =
CInt(myDocument.SeriesCollection(Serie_no).Points( Point_no).DataLabel.Left)
Top_no =
CInt(myDocument.SeriesCollection(Serie_no).Points( Point_no).DataLabel.Top)
Left__no = Left__no + 25
' Add a line
With myDocument.Shapes.AddLine(100, 25, Left__no, Top_no).Line
.DashStyle = msoLineSolid
.ForeColor.RGB = RGB(50, 0, 128)
End With

myDocument.SeriesCollection(Serie_no).Points(Point _no).HasDataLabel =
False
Set myDocument = Nothing
End Sub