Add and edit a shape in VBA

[Hugo Jorgensen]

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

 

[Jim Cone]

Use...
.TextFrame.Characters.Text = strComment
.TextFrame.Characters.Font.Bold = True
.TextFrame.Characters.Font.Size = 18

Also...
A "Comment" is an Object in Excel and should not be used as a variable name.
That doesn't mean it won't always work, but that you are taking the chance that
Excel will always know what you mean/want. I changed it to strComment in my example.

Furthermore...
The use of... Text vs. TextFrame vs. TextEffect will get you again as some point. (I know)
Starting a "code" file and making some notes to yourself can help.
--
Jim Cone
Portland, Oregon USA
(30+ custom ways to sort... http://www.contextures.com/excel-sort-addin.html )




"Hugo Jorgensen" <Hugo (e-mail address removed)>
wrote in message 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