identifying text boxes
 

Hi all,

I was asked to help with this problem and I am struggling to find a
quick way to do it.

I need to retrieve the name of all text boxes in a spreadsheet in the
same order they appear from top to bottom. I have around 10 worksheets
each with 12 - 20 text boxes...

Thanks in advance.

PA

identifying text boxes
 

You didn't say where to display the ordered names at, so I simply added a
new worksheet at the end of your list and listed them there (along with the
worksheet Name they are on, the TextBox's Top value on that sheet, and the
sheet's Index value which was used during the sort process)... you can
delete this worksheet after you are done with it.

Sub ShowTextBoxesNamesInOrder()
Dim X As Long, Z As Long, LastRow As Long
Dim O As Object, WS As Worksheet, LastSheet As Worksheet
Dim TBnames As String, TBs() As Variant
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set LastSheet = Worksheets(Worksheets.Count)
LastSheet.Range("A1:D1") = Array("Sheet Name", "Name", "Top", "Index")
For X = 1 To Worksheets.Count - 1
Z = 0
Set WS = Worksheets(X)
ReDim TBs(1 To WS.OLEObjects.Count, 1 To 4)
For Each O In WS.OLEObjects
If TypeName(O.Object) = "TextBox" Then
Z = Z + 1
TBs(Z, 1) = WS.Name
TBs(Z, 2) = O.Name
TBs(Z, 3) = O.Top
TBs(Z, 4) = X
End If
Next
If Z 0 Then
LastSheet.Cells(Rows.Count, "A").End(xlUp). _
Offset(1).Resize(Z, 4) = TBs
End If
Next
LastRow = LastSheet.Cells(Rows.Count, "A").End(xlUp).Row
LastSheet.Range("A1:D" & LastRow).Sort _
Key1:=LastSheet.Range("D2"), Order1:=xlAscending, _
Key2:=LastSheet.Range("C2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub

--
Rick (MVP - Excel)



"PA" wrote in message
...
Hi all,

I was asked to help with this problem and I am struggling to find a
quick way to do it.

I need to retrieve the name of all text boxes in a spreadsheet in the
same order they appear from top to bottom. I have around 10 worksheets
each with 12 - 20 text boxes...

Thanks in advance.

PA

identifying text boxes
 

Thank you for your help!

I am getting a runtime error 438 always in the line: ReDim TBs(1 To
WS.OLEObjects.Count, 1 To 4)

any suggestion?

thanks in advance!
PA

identifying text boxes
 

Where did the TextBoxes that are on the sheets come from... the Control
ToolBox toolbar or the Drawing toolbar?

--
Rick (MVP - Excel)



"PA" wrote in message
...
Thank you for your help!

I am getting a runtime error 438 always in the line: ReDim TBs(1 To
WS.OLEObjects.Count, 1 To 4)

any suggestion?

thanks in advance!
PA

identifying text boxes
 

If your TextBoxes came from the Drawing toolbar, then try this macro
instead...

Sub ShowTextBoxesNamesInOrder()
Dim X As Long, Z As Long, LastRow As Long
Dim O As Object, WS As Worksheet, LastSheet As Worksheet
Dim TBnames As String, TBs() As Variant
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set LastSheet = Worksheets(Worksheets.Count)
LastSheet.Range("A1:D1") = Array("Sheet Name", "Name", "Top", "Index")
For X = 1 To Worksheets.Count - 1
Z = 0
Set WS = Worksheets(X)
ReDim TBs(1 To WS.Shapes.Count, 1 To 4)
For Each O In WS.Shapes
If TypeName(O.OLEFormat.Object) = "TextBox" Then
Z = Z + 1
TBs(Z, 1) = WS.Name
TBs(Z, 2) = O.Name
TBs(Z, 3) = O.OLEFormat.Object.Top
TBs(Z, 4) = X
End If
Next
If Z 0 Then
LastSheet.Cells(Rows.Count, "A").End(xlUp). _
Offset(1).Resize(Z, 4) = TBs
End If
Next
LastRow = LastSheet.Cells(Rows.Count, "A").End(xlUp).Row
LastSheet.Range("A1:D" & LastRow).Sort _
Key1:=LastSheet.Range("D2"), Order1:=xlAscending, _
Key2:=LastSheet.Range("C2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub

--
Rick (MVP - Excel)



"Rick Rothstein" wrote in message
...
Where did the TextBoxes that are on the sheets come from... the Control
ToolBox toolbar or the Drawing toolbar?

--
Rick (MVP - Excel)



"PA" wrote in message
...
Thank you for your help!

I am getting a runtime error 438 always in the line: ReDim TBs(1 To
WS.OLEObjects.Count, 1 To 4)

any suggestion?

thanks in advance!
PA

identifying text boxes
 

And this macro should list **all** TextBoxes no matter if they came from the
Control ToolBox toolbar or the Drawing toolbar (it also identifies which
toolbar the control is from)....

Sub ShowTextBoxesNamesInOrder()
Dim X As Long, Z As Long, LastRow As Long
Dim O As Object, WS As Worksheet, LastSheet As Worksheet
Dim TBnames As String, TBs() As Variant
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set LastSheet = Worksheets(Worksheets.Count)
LastSheet.Range("A1:E1") = Array("Sheet Name", "Name", "Type", "Top",
"Index")
For X = 1 To Worksheets.Count - 1
Z = 0
Set WS = Worksheets(X)
ReDim TBs(1 To WS.Shapes.Count, 1 To 5)
For Each O In WS.Shapes
If TypeName(O.OLEFormat.Object) = "TextBox" Then
Z = Z + 1
TBs(Z, 1) = WS.Name
TBs(Z, 2) = O.Name
TBs(Z, 3) = "Drawing"
TBs(Z, 4) = O.OLEFormat.Object.Top
TBs(Z, 5) = X
ElseIf TypeName(O.OLEFormat.Object) = "OLEObject" Then
If TypeOf WS.OLEObjects(O.Name).Object Is MSForms.TextBox Then
Z = Z + 1
TBs(Z, 1) = WS.Name
TBs(Z, 2) = O.Name
TBs(Z, 3) = "ActiveX"
TBs(Z, 4) = O.Top
TBs(Z, 5) = X
End If
End If
Next
If Z 0 Then
LastSheet.Cells(Rows.Count, "A").End(xlUp). _
Offset(1).Resize(Z, 5) = TBs
End If
Next
LastRow = LastSheet.Cells(Rows.Count, "A").End(xlUp).Row
LastSheet.Range("A1:E" & LastRow).Sort _
Key1:=LastSheet.Range("E2"), Order1:=xlAscending, _
Key2:=LastSheet.Range("D2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub

--
Rick (MVP - Excel)



"Rick Rothstein" wrote in message
...
If your TextBoxes came from the Drawing toolbar, then try this macro
instead...

Sub ShowTextBoxesNamesInOrder()
Dim X As Long, Z As Long, LastRow As Long
Dim O As Object, WS As Worksheet, LastSheet As Worksheet
Dim TBnames As String, TBs() As Variant
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set LastSheet = Worksheets(Worksheets.Count)
LastSheet.Range("A1:D1") = Array("Sheet Name", "Name", "Top", "Index")
For X = 1 To Worksheets.Count - 1
Z = 0
Set WS = Worksheets(X)
ReDim TBs(1 To WS.Shapes.Count, 1 To 4)
For Each O In WS.Shapes
If TypeName(O.OLEFormat.Object) = "TextBox" Then
Z = Z + 1
TBs(Z, 1) = WS.Name
TBs(Z, 2) = O.Name
TBs(Z, 3) = O.OLEFormat.Object.Top
TBs(Z, 4) = X
End If
Next
If Z 0 Then
LastSheet.Cells(Rows.Count, "A").End(xlUp). _
Offset(1).Resize(Z, 4) = TBs
End If
Next
LastRow = LastSheet.Cells(Rows.Count, "A").End(xlUp).Row
LastSheet.Range("A1:D" & LastRow).Sort _
Key1:=LastSheet.Range("D2"), Order1:=xlAscending, _
Key2:=LastSheet.Range("C2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub

--
Rick (MVP - Excel)



"Rick Rothstein" wrote in message
...
Where did the TextBoxes that are on the sheets come from... the Control
ToolBox toolbar or the Drawing toolbar?

--
Rick (MVP - Excel)



"PA" wrote in message
...
Thank you for your help!

I am getting a runtime error 438 always in the line: ReDim TBs(1 To
WS.OLEObjects.Count, 1 To 4)

any suggestion?

thanks in advance!
PA

identifying text boxes
 

Just brilliant!
thanks a lot

PA