Selecting TextBox Shapes in a particular Row using Macro

[dineshtendulkar]

Guys,

Is it possible to select all shapes (textbox) in a particular row and change the textbox values in it. I am having 3 textbox shapes in each row. I want to select only the shapes of the activerow and then change its values using macro.

Somebody help for this problem.

Thanks in advance.

 

[Worf]

Hello
This will work if your rows are all of the same height:

Sub ChangeTB()
Dim ob As Shape, str$, rh%, tbr(), i%, j%
i = 0
str = ""
rh = ActiveSheet.Rows(1).Height
For Each ob In ActiveSheet.Shapes
    If InStr(ob.Name, "TextBox") > 0 Then
        ReDim Preserve tbr(i)
        tbr(i) = Int(ob.Top / rh) + 1
        str = str & ob.Name & " => " & tbr(i) & vbLf
        i = i + 1
    End If
Next
MsgBox str, vbInformation, "Lines where TextBoxes are:"
For j = 0 To i - 1
    If ActiveCell.Row = tbr(j) Then _
    ActiveSheet.Shapes("TextBox" & (j + 1)).TextFrame.Characters.Text = CStr(j + 1)
Next
End Sub

 

[dineshtendulkar]

But the row height changes depending on the shape present in that particular row. could you send me the code irrespective of the row height.

 

[Worf]

Try this one:

Sub ChangeTB()
Dim ob As Shape, str$, tbr(), i%, j%
i = 0
str = ""


For Each ob In ActiveSheet.Shapes
    If InStr(ob.Name, "TextBox") > 0 Then
        ReDim Preserve tbr(i)
        tbr(i) = ob.TopLeftCell.Row
        str = str & ob.Name & " => " & tbr(i) & vbLf
        i = i + 1
    End If
Next
MsgBox str, vbInformation, "Lines where TextBoxes are:"
For j = 0 To i - 1
    If ActiveCell.Row = tbr(j) Then _
    ActiveSheet.Shapes("TextBox" & (j + 1)).TextFrame.Characters.Text = CStr(j + 1)
Next
End Sub