Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Определение координат шейпов в определенном диапазоне
 
#1
04.01.2019 09:20:00
Утро доброе.
Хочу задать вопрос - по макросу.
Он выписывает адреса шейпов в столбец С.
Но делает это для всех шейпов листа, а не только нужного диапазона G11:O36.
Код
Sub Макрос2()
Dim oDraw As Object, i&

On Error Resume Next
Range("C4").Activate

For Each oDraw In ActiveSheet.DrawingObjects.ShapeRange
    If Not Intersect(ActiveSheet.Shapes(i).TopLeftCell, Range("G11:O36")) Is Nothing Then
    If Range(oDraw.TopLeftCell, oDraw.BottomRightCell) Then
        ActiveCell = oDraw.Name
        ActiveCell.Offset(1).Activate
    End If
    End If
Next oDraw

End Sub
Ответьте - как изменить этот макрос, чтобы он определял координаты выписанных шейпов, находящихся в диапазоне G11:O36 ?
 
 
 
#2
04.01.2019 09:48:21
Код
If Not Intersect(oDraw.TopLeftCell, Range("G11:O36")) Is Nothing Then
 
 
 
#3
04.01.2019 10:33:46
V, понятно.
А как координаты этих выборочных фигур в диапазон D4:E13 проставить ?

Вот нашел такой макрос.
Но он определяет координаты для всех фигур без исключения - и выводит их только в отладчике:
Код
Sub Макрос3()
    Dim Sh As Worksheet, sha As Shape
    For Each Sh In ActiveWorkbook.Worksheets
        Debug.Print "=== Лист «" & Sh.Name & "» - количество фигур: " & Sh.Shapes.Count & " ==="
        For Each sha In Sh.Shapes
            n = n + 1: Debug.Print "   Фигура №" & n & " с названием «" & sha.Name & "»"
            Debug.Print "      Координаты верхнего левого угла: X=" & sha.Left & "; Y=" & sha.Top
            Debug.Print "      Координаты правого нижнего угла: X=" & sha.Left + sha.Width & "; Y=" & sha.Top + sha.Height
            Debug.Print "      Размеры фигуры: ширина=" & sha.Width & "; высота=" & sha.Height
            Debug.Print "      Тип фигуры: " & sha.Type & "; тип автофигуры: " & sha.AutoShapeType
        Next sha
        Debug.Print "=== Конец просмотра листа «" & Sh.Name & "» ===" & vbNewLine
    Next Sh
End Sub
 
 
 
#4
04.01.2019 11:07:51
Код
Dim oDraw As Object, i&
i = 4
On Error Resume Next


For Each oDraw In ActiveSheet.Shapes
    If Not Intersect(oDraw.TopLeftCell, Range("G11:O36")) Is Nothing Then
        Cells(i, 3) = oDraw.Name
        Cells(i, 4) = oDraw.Left
        Cells(i, 5) = oDraw.Top
        i = i + 1
    End If
Next oDraw

координаты относительно чего?
 
 
 
#5
04.01.2019 11:14:34
Цитата
V написал:
координаты относительно чего?
Координаты относительно собственно листа.
Имеется ввиду левый верхний угол шейпа.
По этой координате - шейп размещается на листе.
 
 
 
#6
04.01.2019 11:18:17
Цитата
radioamator написал:
Координаты относительно собственно листа.
тогда предложенный код подойдет.
 
 
 
#7
31.08.2019 01:26:04
Ну как говорится, спасибо вам всем.
И низкий поклон в пояс.
 
 
 
Страницы: 1
Наверх