A Microsoft Office (Excel, Word) forum. OfficeFrustration

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » OfficeFrustration forum » Microsoft Excel » General Discussion
Site Map Home Register Authors List Search Today's Posts Mark Forums Read  

Add and edit a shape in VBA



 
 
Thread Tools Display Modes
  #1  
Old April 19th, 2010, 08:02 AM posted to microsoft.public.excel.misc
Hugo Jorgensen
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
  #2  
Old April 19th, 2010, 04:15 PM posted to microsoft.public.excel.misc
Jim Cone[_2_]
external usenet poster
 
Posts: 434
Default Add and edit a shape in VBA


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
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
 




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Forum Jump


All times are GMT +1. The time now is 05:43 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 OfficeFrustration.
The comments are property of their posters.