Как определить Адрес ячейки по ее координатам?

[AlexanderFadin]

Добрый день, Уважаемые!
Подскажите пожалуйста как определить адрес ячейки по ее координатам?
Поясняю У меня есть скрипт, найденный на просторах Интернета, который определяет имена картинок на листе, а также ее координаты. Как исходя из этих координатов определить в какой ячейке находится эта картинка? К сожалению поиск по форуму результата не дал, точнее сказать, нашел тему про полилинии http://www.excel-vba.ru/forum/index.php?topic=472.0, где был выложен скрипт, который выдавал координаты курсора мыши и одновременно адрес ячейки, но вот приспособить под свои нужды не сумел.
Собственно, скрипт:

Код:

Sub GetShapeProperties()
Dim sShapes As Shape, lLoop As Long
Dim wsStart As Worksheet, WsNew As Worksheet        ''''''''''''''''''''''''''''''''''''''''''''''''    ''''''''''LIST PROPERTIES OF SHAPES'''''''''''''    ''''''''''Dave Hawley www.ozgrid.com''''''''''''    ''''''''''''''''''''''''''''''''''''''''''''''''
Set wsStart = ActiveSheet
Set WsNew = Sheets.Add         'Add headings for our lists. Expand as needed
WsNew.Range("A1:F1") = _
     Array("Shape Name", "Shape Type", "Height", "Width", "Left", "Top")              'Loop through all shapes on active sheet
For Each sShapes In wsStart.Shapes        'Increment Variable lLoop for row numbers
lLoop = lLoop + 1
With sShapes            'Add shape properties
WsNew.Cells(lLoop + 1, 1) = .Name
WsNew.Cells(lLoop + 1, 2) = .OLEFormat.Object.Name
WsNew.Cells(lLoop + 1, 3) = .Height
WsNew.Cells(lLoop + 1, 4) = .Width
WsNew.Cells(lLoop + 1, 5) = .Left
WsNew.Cells(lLoop + 1, 6) = .Top            'Follow the same pattern for more
End With
Next sShapes          'AutoFit Columns.
WsNew.Columns.AutoFit
End Sub

[nilem]

...Как исходя из этих координат определить, в какой ячейке находится эта картинка?

Попробуйте вот это прикрутить:

Код:

Sub ert()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
    MsgBox shp.Name & "; " & shp.TopLeftCell.Address
    MsgBox shp.Name & "; " & shp.BottomRightCell.Address
Next
End Sub

[AlexanderFadin]

Ура, получилось, большое спасибо!
Вот так прикрутил к своему коду
With sShapes            'Add shape properties
WsNew.Cells(lLoop + 1, 1) = .Name
WsNew.Cells(lLoop + 1, 2) = .OLEFormat.Object.Name
WsNew.Cells(lLoop + 1, 3) = .Height
WsNew.Cells(lLoop + 1, 4) = .Width
WsNew.Cells(lLoop + 1, 5) = .Left
WsNew.Cells(lLoop + 1, 6) = .Top
WsNew.Cells(lLoop + 1, 7) = .TopLeftCell.Address

Код:

Sub GetShapeProperties()
Dim sShapes As Shape, lLoop As Long
Dim wsStart As Worksheet, WsNew As Worksheet        ''''''''''''''''''''''''''''''''''''''''''''''''    ''''''''''LIST PROPERTIES OF SHAPES'''''''''''''    ''''''''''Dave Hawley www.ozgrid.com''''''''''''    ''''''''''''''''''''''''''''''''''''''''''''''''
Set wsStart = ActiveSheet
Set WsNew = Sheets.Add         'Add headings for our lists. Expand as needed
WsNew.Range("A1:G1") = _
     Array("Shape Name", "Shape Type", "Height", "Width", "Left", "Top", "Adress")              'Loop through all shapes on active sheet
For Each sShapes In wsStart.Shapes        'Increment Variable lLoop for row numbers
lLoop = lLoop + 1
With sShapes            'Add shape properties
WsNew.Cells(lLoop + 1, 1) = .Name
WsNew.Cells(lLoop + 1, 2) = .OLEFormat.Object.Name
WsNew.Cells(lLoop + 1, 3) = .Height
WsNew.Cells(lLoop + 1, 4) = .Width
WsNew.Cells(lLoop + 1, 5) = .Left
WsNew.Cells(lLoop + 1, 6) = .Top
WsNew.Cells(lLoop + 1, 7) = .TopLeftCell.Address
End With
Next sShapes          'AutoFit Columns.
WsNew.Columns.AutoFit
End Sub