Text Boxes in specific locations

[mcmahobt]

Hello all!

I'm hoping for some help in altering the below code to insert a text box below the shape as it is inserted. Realize a sample workbook is probably more helpful but I'm not sure how/if I can attach one. Thoughts on a way ahead would be appreciated!


<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub Testing()

'Calls the Named Ranges needed for the code to run
Dim myCell As Range
Dim mySel As Range
'Sets dimension to center pictures within cell
Dim myR As Range
Dim myP As Shape


Set mySel = Selection

With Application
.ScreenUpdating = False
Rows("4:4").EntireRow.Hidden = False

'Checks first to see if a cell within the named range is blank, skips if it is, and calls the appropriate image if not
On Error Resume Next
For Each myCell In Range("KeyCells")
If myCell <> "" Then
'Deletes old image and replaces it with the called new one
ActiveSheet.Shapes(myCell.Address & "Final").Delete
ActiveSheet.Shapes(myCell.Value).Select
Selection.Copy
myCell.Offset(0, 0).Select
ActiveSheet.Paste
Selection.Name = myCell.Address & "Final"
Selection.ShapeRange.ZOrder msoSendToBack
Selection.AddTextbox(msoTextOrientationHorizontal, 2.5, 1.5, 116, 145).TextFrame.Characters.Text = "Test"
'Centers pictures within cell
With Selection
Set myR = .TopLeftCell
.Left = myR.Left + (myR.Width - .Width) / 2
.Top = myR.Top + (myR.Height - .Height) / 2
End With
Else: ActiveSheet.Shapes(myCell.Address & "Final").Delete
GoTo Skip
End If
Skip:
Next myCell
mySel.Select

Rows("4:4").EntireRow.Hidden = True
.ScreenUpdating = True

End With

End Sub
</code>

 

[Kenneth Hobson]

Please paste code between code tags. Insert them by clicking the # icon on the toolbar. This forum does not allow file attachments. You can post a link from a shared site like dropbox.com.

You are already using the methods needed. The key is to get the topleftcell. You can use With when you create the textbox object or Set it to an Object type. You can then use top and left to move to another cell's top and left or your Shape's top and left. The height part will be the more difficult part maybe. I will have to think on that.

There is seldom a need to use Activate, Select, and Selection. In this case, some use may be fine.

 

[mcmahobt]

Got it, thanks for the input and some direction! If you think of anything else I'm all ears.

 

[Kenneth Hobson]

The shape's bottomrightcell may help as well. Offset() for that cell might help as well. Of course you can get the height of the shape or cell but that can get tricky.

Use MsgBox() or Debug.Print to get quick information as you develop it. The latter puts the results of a run into VBE's Immediate Windows. Click VBE's View menu to show that window if not selected already.