Moving a shape with text inside without editing text

[Guest]

I am working on a project in Excel. I need to generate a shape, place text
inside that shape, and then allow the user to drag that shape around on the
sheet.

I have not been successful adding a shape, then using the TextFrame property
to add the text. Also have tried placing a text box.

If there is a way to "lock" the text so that it cannot be edited, maybe that
would work, but I can't find a way to do that.
Or, if there is a way to maybe add another shape on top of the text, and
group the text box to the shape, so that selecting the group and dragging has
the desired effect.

Can this be done? There must be a trick out there somewhere!

Thanks in advance.

 

[Guest]

Yes There arr tricks. I went to the View Menu and adding the Drawing Toolbar
to my Excel workbook. I then recorded a new macro while I added a rectangle.
I then put a Textbox in the rectangle and added some text. The Macro3 below
is what was generated. To find the real name of the text again requires
tricks. I right clicked on the rectangle and selected Assign Macro where the
macro name was Rectangle2_Click. Now I knew the rectangle was called
Rectangle2. but you need to add a space to the name (see macro below). To
debug problems I add MyShape to watch window and then go into the wattch to
help find problems. that is how I found I needed to add a space in the
reference to "Ractangel 2"

Sub changetext()
For Each MyShape In Worksheets("sheet1").Shapes
Myshapename = MyShape.Name
Next MyShape

Set MyShape = Worksheets("sheet1").Shapes("rectangle 2")

End Sub



:


Sub Macro3()
'
' Macro3 Macro
' Macro recorded 3/10/2007 by jwarburg
'

'
Range("D15").Select
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 280.5, 167.25, 72#, 72#). _
Select
Selection.ShapeRange.ScaleWidth 2.28, msoFalse, msoScaleFromBottomRight
Selection.ShapeRange.ScaleHeight 1.34, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("Rectangle 2").Select
Selection.Characters.Text = ""
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.ShapeRange.ScaleWidth 0.86, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 1.28, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.18, msoFalse, msoScaleFromBottomRight
ActiveSheet.Shapes("Rectangle 2").Select
Selection.Characters.Text = "this is my message"
With Selection.Characters(Start:=1, Length:=18).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D8").Select
End Sub

 

[NOPIK]

Dim shp As Shape
Set shp = ActiveWorksheet.Shapes.AddShape(msoShapeRectangle,
CentimetersToPoints(1.5), CentimetersToPoints(1.5),
CentimetersToPoints(1.5), CentimetersToPoints(1.5), Selection.Range)
shp.Name = "MyName1"
shp.OnAction "ActionHandler"
ActiveWorksheet.Shapes.Range(Array("MyName0", "MyName1")).Group

 

[Nick Hebb]

Hi Dan,

In order to lock the text, the worksheet must be protected. The code
below will unprotect the sheet, add a shape to it, add the text, then
lock the text while still allowing you to move the shape around, and
finally re-protect the sheet.

Sub AddLockedTextShape()

Dim ws As Worksheet
Dim shp As Shape
Dim rng As Range
Dim w As Single
Dim h As Single

w = 48# ' standard cell width
h = 12.75 ' standard cell height

Set ws = ActiveSheet
Set rng = ws.Range("C3")

ws.Unprotect ' optional: use a password

Set shp = ws.Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top,
w, 4 * h)
shp.TextFrame.Characters.Text = "My Text"
shp.Select

' These don't have any affect unless the sheet is protected
With Application.Selection
.LockedText = True
.Locked = False
End With

ws.Protect

Set rng = Nothing
Set shp = Nothing
Set ws = Nothing

End Sub


HTH,

Nick Hebb
BreezeTree Software
http://www.breezetree.com