Multiple Activex TextBox on sheet auto size and move

[Kenny]

I have a sheet with 6 text boxes one under the other. I would like to start
each box vertically sized to contain one row of data - then as the user types
it autosizes vertically to fit what has been typed - while this is happening
the boxes below it will move their position downward but keep the same
spacing between them - any ideas on code? THANKS!

 

[Peter T]

Try the following in the sheet module

Const mcTB_WD As Single = 99

Private Sub TextBox1_Change()
TBwidth TextBox1
End Sub

Private Sub TextBox2_Change()
TBwidth TextBox2
End Sub

Private Sub TextBox3_Change()
TBwidth TextBox3
End Sub

Private Sub TBwidth(oTB As msforms.TextBox)
With oTB
If .Width <> mcTB_WD Then .Width = mcTB_WD
End With
End Sub


Private Sub TBoxProps()
Dim ole As OLEObject
For Each ole In Me.OLEObjects
If InStr(1, ole.progID, "TextBox") Then
ole.Object.MultiLine = True
ole.Object.AutoSize = True
ole.Object.WordWrap = True
ole.Width = mcTB_WD
If Len(ole.Object.Text) < 5 Then
' ole.Height = 18
End If
End If
Next
End Sub

Manually run TBoxProps to set the properties. Apart from autosize, multilne
& wrap adjust other properties to your needs.

Regards,
Peter T