Get the exact position or coordinates, L,R,U,D of a object (option button)on a worksheet?

Event2020

Board Regular
Joined
Jan 6, 2011
Messages
122
Office Version
  1. 2019
Platform
  1. Windows
I am using Excel 2007

Is there a way of seeing or getting the exact position coordinates of a object on a worksheet, maybe a macro that can return or display the coordinates into a cell or on the clip board?

The object is a option box called "OptionBox1"

What I mean by exact position is the left, right, up & down position.

This is because, depending on the options a user selects, the option box "OptionBox1" will be deleted and then, depending on other options a user selects, I have a macro that will create it again.

The thing I am having issues with is I want to be able to exactly place the new "OptionBox1".

I have right clicked on the option box and looked at its format and properties but there is no way to position that way so I am assuming it must be done from within the macro that creates it.


Thanks
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Code:
Sub ReportShapes()


Dim Worksheet_ As Worksheet
Dim SheetLoop_ As Worksheet
Dim Shape_ As Shape
Dim Loop1_ As Integer
Dim Time_ As String


Set Worksheet_ = Sheets.Add


Worksheet_.Range("A1:J1") = Array("Sheet", "Top Left", "Bottom Right", "Type", "Name", "ID", "Across", "Down", "Wide", "Tall")


For Each SheetLoop_ In Worksheets
     For Each Shape_ In SheetLoop_.Shapes
     Loop1_ = Loop1_ + 1
          With Shape_
               Worksheet_.Cells(Loop1_ + 1, 1) = SheetLoop_.Name
               Worksheet_.Cells(Loop1_ + 1, 2) = .TopLeftCell.Address
               Worksheet_.Cells(Loop1_ + 1, 3) = .BottomRightCell.Address
               Worksheet_.Cells(Loop1_ + 1, 4) = .AutoShapeType
               Worksheet_.Cells(Loop1_ + 1, 5) = .Name
               Worksheet_.Cells(Loop1_ + 1, 6) = .ID
               Worksheet_.Cells(Loop1_ + 1, 7) = .Left
               Worksheet_.Cells(Loop1_ + 1, 8) = .Top
               Worksheet_.Cells(Loop1_ + 1, 9) = .Width
               Worksheet_.Cells(Loop1_ + 1, 10) = .Height
          End With
     Next Shape_
Next SheetLoop_


' Format Report


Selection.RowHeight = 16
Rows("1:1").RowHeight = 20


ActiveWindow.DisplayGridlines = False


Columns("A:J").ColumnWidth = 12
Columns("E:E").ColumnWidth = 50
Columns("G:J").NumberFormat = "#,##0"
Columns("B:C").Replace What:="$", Replacement:="  "


Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
With Selection
.Interior.Color = RGB(240, 240, 210)
.Borders.LineStyle = xlContinuous
.Borders.Color = RGB(200, 200, 200)
End With


Range("A1:J1").Interior.Color = RGB(200, 250, 200)
Range("A1:J1").Font.Size = 12


Range("A2").Select
ActiveWindow.FreezePanes = True
Cells.VerticalAlignment = xlCenter
Cells.HorizontalAlignment = xlCenter


Time_ = Format(Now(), "h.mm")
ActiveSheet.Name = "Shapes at " & Time_


End Sub

This code will create a list of all the shapes in the worksheet.
 
Upvote 0
You can obtain or assign the Top, Left, Height and Width using the Shapes object specifying your OptionButton's name as its argument. You can store those values in any sheet/cell you want and later retrieve those values from that location and assign it back to the shape again. For example, using your OptionButton's name of "OptionBox1" (I'll assume the OptionButton is on Sheet2 and its properties will be stored on Sheet9), this code will store the current properties for the OptionButton for later retrieval...
Code:
[table="width: 500"]
[tr]
	[td]Sheets("Sheet9").Range("A1").Value = Sheets("Sheet2").Shapes("OptionBox1").Top
Sheets("Sheet9").Range("A2").Value = Sheets("Sheet2").Shapes("OptionBox1").Left
Sheets("Sheet9").Range("A3").Value = Sheets("Sheet2").Shapes("OptionBox1").Height
Sheets("Sheet9").Range("A4").Value = Sheets("Sheet2").Shapes("OptionBox1").Width[/td]
[/tr]
[/table]
To retrieve the values and apply them back to OptionBox1 once it has been placed back on Sheet2...
Code:
[table="width: 500"]
[tr]
	[td]Sheets("Sheet2").Shapes("OptionBox1").Top =  Sheets("Sheet9").Range("A1").Value
Sheets("Sheet2").Shapes("OptionBox1").Left =  Sheets("Sheet9").Range("A2").Value
Sheets("Sheet2").Shapes("OptionBox1").Height=  Sheets("Sheet9").Range("A3").Value
Sheets("Sheet2").Shapes("OptionBox1").Width =  Sheets("Sheet9").Range("A4").Value[/td]
[/tr]
[/table]
 
Upvote 0
Code:
Sub ReportShapes()


Dim Worksheet_ As Worksheet
Dim SheetLoop_ As Worksheet
Dim Shape_ As Shape
Dim Loop1_ As Integer
Dim Time_ As String


Set Worksheet_ = Sheets.Add


Worksheet_.Range("A1:J1") = Array("Sheet", "Top Left", "Bottom Right", "Type", "Name", "ID", "Across", "Down", "Wide", "Tall")


For Each SheetLoop_ In Worksheets
     For Each Shape_ In SheetLoop_.Shapes
     Loop1_ = Loop1_ + 1
          With Shape_
               Worksheet_.Cells(Loop1_ + 1, 1) = SheetLoop_.Name
               Worksheet_.Cells(Loop1_ + 1, 2) = .TopLeftCell.Address
               Worksheet_.Cells(Loop1_ + 1, 3) = .BottomRightCell.Address
               Worksheet_.Cells(Loop1_ + 1, 4) = .AutoShapeType
               Worksheet_.Cells(Loop1_ + 1, 5) = .Name
               Worksheet_.Cells(Loop1_ + 1, 6) = .ID
               Worksheet_.Cells(Loop1_ + 1, 7) = .Left
               Worksheet_.Cells(Loop1_ + 1, 8) = .Top
               Worksheet_.Cells(Loop1_ + 1, 9) = .Width
               Worksheet_.Cells(Loop1_ + 1, 10) = .Height
          End With
     Next Shape_
Next SheetLoop_


' Format Report


Selection.RowHeight = 16
Rows("1:1").RowHeight = 20


ActiveWindow.DisplayGridlines = False


Columns("A:J").ColumnWidth = 12
Columns("E:E").ColumnWidth = 50
Columns("G:J").NumberFormat = "#,##0"
Columns("B:C").Replace What:="$", Replacement:="  "


Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
With Selection
.Interior.Color = RGB(240, 240, 210)
.Borders.LineStyle = xlContinuous
.Borders.Color = RGB(200, 200, 200)
End With


Range("A1:J1").Interior.Color = RGB(200, 250, 200)
Range("A1:J1").Font.Size = 12


Range("A2").Select
ActiveWindow.FreezePanes = True
Cells.VerticalAlignment = xlCenter
Cells.HorizontalAlignment = xlCenter


Time_ = Format(Now(), "h.mm")
ActiveSheet.Name = "Shapes at " & Time_


End Sub

This code will create a list of all the shapes in the worksheet.


Hi Zenwood

Thank you for taking the time to do this.

It is going to really help me on this and other projects.

:)
 
Upvote 0
You can obtain or assign the Top, Left, Height and Width using the Shapes object specifying your OptionButton's name as its argument. You can store those values in any sheet/cell you want and later retrieve those values from that location and assign it back to the shape again. For example, using your OptionButton's name of "OptionBox1" (I'll assume the OptionButton is on Sheet2 and its properties will be stored on Sheet9), this code will store the current properties for the OptionButton for later retrieval...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sheets("Sheet9").Range("A1").Value = Sheets("Sheet2").Shapes("OptionBox1").Top
Sheets("Sheet9").Range("A2").Value = Sheets("Sheet2").Shapes("OptionBox1").Left
Sheets("Sheet9").Range("A3").Value = Sheets("Sheet2").Shapes("OptionBox1").Height
Sheets("Sheet9").Range("A4").Value = Sheets("Sheet2").Shapes("OptionBox1").Width[/TD]
[/TR]
</tbody>[/TABLE]
To retrieve the values and apply them back to OptionBox1 once it has been placed back on Sheet2...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sheets("Sheet2").Shapes("OptionBox1").Top =  Sheets("Sheet9").Range("A1").Value
Sheets("Sheet2").Shapes("OptionBox1").Left =  Sheets("Sheet9").Range("A2").Value
Sheets("Sheet2").Shapes("OptionBox1").Height=  Sheets("Sheet9").Range("A3").Value
Sheets("Sheet2").Shapes("OptionBox1").Width =  Sheets("Sheet9").Range("A4").Value[/TD]
[/TR]
</tbody>[/TABLE]


Hi Rick

Thank you for your kind help on this.

This is exactly what I need and works perfectly.

Thanks again
:)
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,169
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