identifying text boxes

P

PA

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
 
R

Rick Rothstein

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
 
P

PA

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
 
R

Rick Rothstein

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

Rick Rothstein

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
 
R

Rick Rothstein

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
 

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

Similar Threads

Using Multiple Monitors with Excel Spreadsheet with VBA Code 1
Need VBA Code to Select text boxes in spreadsheet 2
Protect several objects 2
Linking textboxes with option boxes 4
Maintaining Text Box Font Setting through VB 4
Macro search text boxes 5
Userform List boxes - editing - then option to save changes (or no 3
Using a single cmdButton to perform different tasks 5

Top