Macro to resize textboxes to fit exactly on the cell its sitting on

Question

I am using Excel 2013 and have created some macros and am currently embedding them into textboxes. How would I make a macro that takes selected textboxes and centers them and sizes them to fit exactly on the cell that they are sitting on.

Sub TextBox2Cell()
    With ActiveCell
        ActiveSheet.Shapes.AddTextbox _
          msoTextOrientationHorizontal, .Left, _
          .Top, .Width, .Height
    End With
End Sub

I have this code to create newtext boxes but need to do this with already created textboxes.

Answer 1

You can refer to each textbox's .TopLeftCell property instead of ActiveCell, then run a subroutine like this to adjust each textbox dimensions to match the underlying cell's dimensions:

Sub ResizeAllTextBoxes()
Dim cl As Range
Dim tb As textbox

For Each tb In ActiveSheet.TextBoxes
    Set cl = tb.TopLeftCell
    With cl
        tb.Height = .Height
        tb.Width = .Width
        tb.Left = .Left
        tb.Top = .Top
    End With
Next
End Sub