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.

score 3 · Accepted Answer · answered Aug 15 '14 at 15:51

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

score 0 · Answer 2 · answered Aug 15 '14 at 15:55

If you want to add a textbox to the activecell, then:

Sub CoverRange()
    Dim r As Range
    Dim L As Long, T As Long, W As Long, H As Long
    Set r = ActiveCell
    L = r.Left
    T = r.Top
    W = r.Width
    H = r.Height
    With ActiveSheet.Shapes
        .AddTextbox(msoTextOrientationHorizontal, L, T, W, H).Select
    End With
End Sub

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

2 Answers2