add another text box

S

spence

on sheet1 i have commandbotton1
i want to click commandbutton1 and have the macro add a
text box. if text box1's Top property = 20 i want text
box2's Top property to be 40 and textbox3's to be 40 and
so on. i am trying to work with a loop, but cant quite
figure it out, Thanks...spence.
 
D

Doug Glancy

Spence,

This is what I came up with:

Private Sub CommandButton1_Click()

Dim ctl As Control
Dim txtbox_top As Integer, txtbox_left As Integer, _
txtbox_height As Integer, txtbox_width As Integer, _
txtbox_count As Integer

txtbox_top = 0
txtbox_left = 10 ' something to start with
txtbox_height = 10
txtbox_width = 20
txtbox_count = 0

For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Then
If ctl.Top > txtbox_top Then
With ctl
txtbox_top = .Top
txtbox_left = .Left
txtbox_height = .Height
txtbox_width = .Width
End With
End If
txtbox_count = txtbox_count + 1
End If
Next ctl

Set ctl = Me.Controls.Add("Forms.TextBox.1", "TextBox" & txtbox_count + 1)
With ctl
.Top = txtbox_top + 20
.Left = txtbox_left
.Height = txtbox_height
.Width = txtbox_width
End With

End Sub

hth,

Doug
 
S

spence

it errored out on:
For Each ctl In Me.Controls

i am actually trying to have it add a text box for every
ite in range A1:A??. if there is something in A2 i want
to add a second text box. thanks for your help...S
 
D

Doug Glancy

Spence,

Sorry, stupid of me. I thought it was a userform, even though clearly not.

The following is a start. I need more info on size and location of the
textboxes. This puts the boxes in column B.

Private Sub CommandButton1_Click()
Dim ctl As Shape
Dim txtbox_top As Integer, txtbox_left As Integer, _
txtbox_height As Integer, txtbox_width As Integer, _
txtbox_count As Integer, i As Integer

txtbox_top = 0
txtbox_left = ActiveSheet.Columns(1).Width ' something to start with
txtbox_height = 10
txtbox_width = ActiveSheet.Columns(2).Width
txtbox_count = 0

For Each ctl In ActiveSheet.Shapes
If ctl.Type = 17 Then
If ctl.Top > txtbox_top Then
MsgBox "t"
With ctl
txtbox_top = .Top
txtbox_left = .Left
txtbox_height = .Height
txtbox_width = .Width
End With
End If
txtbox_count = txtbox_count + 1
End If
Next ctl

For i = 1 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row -
txtbox_count
Set ctl = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
txtbox_left, txtbox_top, txtbox_width, txtbox_height)
txtbox_top = txtbox_top + 20
Next i

End Sub

hopefully that's a little better,

Doug
 
D

Doug Glancy

Spence,

I left a msgbox line in there that you didn't need. Here it is again
without it:

Private Sub CommandButton1_Click()
Dim ctl As Shape
Dim txtbox_top As Integer, txtbox_left As Integer, _
txtbox_height As Integer, txtbox_width As Integer, _
txtbox_count As Integer, i As Integer

txtbox_top = 0
txtbox_left = ActiveSheet.Columns(1).Width
txtbox_height = 10
txtbox_width = ActiveSheet.Columns(2).Width
txtbox_count = 0

For Each ctl In ActiveSheet.Shapes
If ctl.Type = 17 Then
If ctl.Top > txtbox_top Then
With ctl
txtbox_top = .Top
txtbox_left = .Left
txtbox_height = .Height
txtbox_width = .Width
End With
End If
txtbox_count = txtbox_count + 1
End If
Next ctl

For i = 1 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row -
txtbox_count
Set ctl = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
txtbox_left, txtbox_top, txtbox_width, txtbox_height)
txtbox_top = txtbox_top + 20
Next i

End Sub

hth,

Doug
 
D

Doug Glancy

Spence,

Hoo boy. So, this is how I'm teaching myself programming, ya see...

Anyways, I noticed that the last iteration didn't quite work if there were
already textboxes - it wrote the first new one over the last old one. So,
after this I'm going to wait and see if this is even on the right track for
you.:

Private Sub CommandButton1_Click()
Dim ctl As Shape
Dim txtbox_top As Integer, txtbox_left As Integer, _
txtbox_height As Integer, txtbox_width As Integer, _
txtbox_spacing As Integer, txtbox_count As Integer, i As Integer

txtbox_top = 0
txtbox_left = ActiveSheet.Columns(1).Width
txtbox_height = 10
txtbox_width = ActiveSheet.Columns(2).Width
txtbox_spacing = 20
txtbox_count = 0

For Each ctl In ActiveSheet.Shapes
If ctl.Type = 17 Then
If ctl.Top > txtbox_top Then
With ctl
txtbox_top = .Top
txtbox_left = .Left
txtbox_height = .Height
txtbox_width = .Width
End With
End If
txtbox_count = txtbox_count + 1
End If
Next ctl

If txtbox_count > 0 Then
txtbox_top = txtbox_top + txtbox_spacing
End If

For i = 1 To ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row -
txtbox_count
Set ctl = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
txtbox_left, txtbox_top, txtbox_width, txtbox_height)
txtbox_top = txtbox_top + txtbox_spacing
Next i

End Sub

hth,

Doug
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top