Finding Multiple Shapes

gtd526

Well-known Member
Joined
Jul 30, 2013
Messages
696
Office Version
  1. 2019
Platform
  1. Windows
I can't find the 2nd or 3rd Shape I'm want to edit.
It locates the 1st one, but not the 2nd or 3rd.
I used "record macro" to select the shapes and get the name.

Sub PleaseFind()

ActiveSheet.Shapes("Rectangle 9").Select

ActiveSheet.Shapes("Rectangle 5").Select

ActiveSheet.Shapes("Rectangle 6").Select

End Sub



The actual code I'm using:

Dim Result As Integer
Dim Result2 As Integer

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''find Min and Max Values for Shape1

Result = Application.WorksheetFunction.Max(Range("a2:a20"))
MsgBox Result
Result2 = Application.WorksheetFunction.Min(Range("a2:a20"))
MsgBox Result2

''apply Min and Max Value to 1st Shape
With ActiveSheet.Shapes("Rectangle 9")
.Height = Result
.Width = 72 * 1.59
End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''find Min and Max Values for Shape2

Result = Application.WorksheetFunction.Max(Range("a21:a79"))
'MsgBox Result
Result2 = Application.WorksheetFunction.Min(Range("a21:a79"))
'MsgBox Result2

''apply Min and Max Value to 2nd Shape
''''''''''''''''''not finding Rectangle 5''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With ActiveSheet.Shapes("Rectangle 5")
.Height = Result
.Width = 72 * 5.54
End With

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''find Min and Max Values for Shape3

Result = Application.WorksheetFunction.Max(Range("a80:a88"))
'MsgBox Result
Result2 = Application.WorksheetFunction.Min(Range("a80:a88"))
'MsgBox Result2

''apply Min and Max Value to 3rd Shape
''''''''''''''not finding Rectangle 6'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
With ActiveSheet.Shapes("Rectangle 6")
.Height = Result
.Width = 72 * 1.62
End With

Once I can find the 2nd and 3rd shape, I will ask how to set the height using Top and Bottom Values for the shape and the width according to columns in the chart. I'm using shapes to go over a Column Chart to define the Range of Min and Max values according to several columns in the chart.

Thanks for your help.
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
This will give you the cell address of the upper left corner of each rectangle, whether or not the shape is visible.Change shape names to suit.
Code:
Sub FindMyShapes()
With ActiveSheet
   MsgBox .Shapes("Rectangle 1").TopLeftCell.Address
   MsgBox .Shapes("Rectangle 2").TopLeftCell.Address
   MsgBox .Shapes("Rectangle 3").TopLeftCell.Address
End With
   
End Sub
 
Upvote 0
Thanks for your help.
I used your code and it was only finding the first one.
I kept digging, so I deleted the first shape and copied the second one, it was finding this one.
Now, it finds all shapes I'm asking to select :)
The copy/paste changed the name and retained all the "properties" of the second one, it worked.
I used the following code to fix:

Sub fixit()

ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Shapes("Rectangle 8").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Shapes("Rectangle 5").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Shapes("Rectangle 6").Select


End Sub

I think 'properties' of the shape had something to do with the error????? I'm only assuming, but now it works.

I will experiment with the size and position of the rectangle shapes (overlapping my column chart).
I get into 'investigative mode' when something doesn't work.

Thanks for your help.
P.S. I'm not 19 anymore, everyone forgets, it not a crime. With age comes wisdom, I think :)
 
Upvote 0

Forum statistics

Threads
1,224,817
Messages
6,181,149
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top