Данный макрос производит поиск фигур (графических объектов) на всех листах текущей книги Excel,
и выводит следующую информацию по каждой найденной фигуре:
-
Название фигуры (графического объекта)
-
Координаты верхнего левого угла
-
Координаты правого нижнего угла
-
Размеры фигуры (ширина, высота)
-
Тип фигуры (свойство Type типа MsoShapeType)
-
Тип автофигуры (свойство AutoShapeType типа MsoAutoShapeType)
Вывод информации производится в окно Immediate
Sub ВыводСпискаАвтофигурСКоординатами()
Dim sh As Worksheet, sha As Shape
For Each sh In ThisWorkbook.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
В прикреплённом файле нажмите кнопку «Запуск» для запуска макроса
Результат работы макроса:
=== Лист «Лист1» - количество фигур: 4 ===
Фигура №1 с названием «КнопкаЗапуска»
Координаты верхнего левого угла: X=48; Y=25,5
Координаты правого нижнего угла: X=144; Y=51
Размеры фигуры: ширина=96; высота=25,5
Тип фигуры: 1; тип автофигуры: 5
Фигура №2 с названием «AutoShape 2»
Координаты верхнего левого угла: X=105; Y=121,5
Координаты правого нижнего угла: X=216; Y=213,75
Размеры фигуры: ширина=111; высота=92,25
Тип фигуры: 1; тип автофигуры: 89
Фигура №3 с названием «Солнце»
Координаты верхнего левого угла: X=255; Y=49,5
Координаты правого нижнего угла: X=315,75; Y=107,25
Размеры фигуры: ширина=60,75; высота=57,75
Тип фигуры: 1; тип автофигуры: 23
Фигура №4 с названием «Oval 4»
Координаты верхнего левого угла: X=341,25; Y=154,5
Координаты правого нижнего угла: X=459; Y=197,25
Размеры фигуры: ширина=117,75; высота=42,75
Тип фигуры: 1; тип автофигуры: 9
=== Конец просмотра листа «Лист1» ===
=== Лист «Лист2» - количество фигур: 2 ===
Фигура №5 с названием «WordArt 1»
Координаты верхнего левого угла: X=78,75; Y=27,75
Координаты правого нижнего угла: X=170,25; Y=120,75
Размеры фигуры: ширина=91,5; высота=93
Тип фигуры: 15; тип автофигуры: -2
Фигура №6 с названием «Стрелка»
Координаты верхнего левого угла: X=202,5; Y=81
Координаты правого нижнего угла: X=277,5; Y=188,25
Размеры фигуры: ширина=75; высота=107,25
Тип фигуры: 9; тип автофигуры: -2
=== Конец просмотра листа «Лист2» ===
Скриншот результата: http://ExcelVBA.ru/pictures/20110925-5vf-80kb.jpg
А следующий код назначает всем автофигурам макрос с названием МакросДляФигуры:
Sub НазначениеОдногоМакросаВсемФигурам()
Dim Sh As Worksheet, sha As Shape
For Each Sh In ActiveWorkbook.Worksheets ' перебираем все листы в активной книге
For Each sha In Sh.Shapes ' перебираем все фигуры на очередном листе
' назначаем макрос только тем фигурам, которым ещё не назначены макросы
If sha.OnAction = "" Then sha.OnAction = "МакросДляФигуры"
Next sha
Next Sh
End Sub
Назначенный макрос выводиn во вторую строку активного листа Excel информацию о выделенной фигуре: координаты, размеры, и название фигуры:
(см. пример в прикреплённом файле - пощелкайте на фигурах, кроме зеленой кнопки)
Sub МакросДляФигуры()
On Error Resume Next
' получаем ссылку на фигуру, с которой был вызван этот макрос
Dim sha As Shape: Set sha = ActiveSheet.Shapes(Application.Caller)
' заносим в диапазон ячеек a2:f2 координаты и размеры выделенной фигуры
Range("a2:f2").Value = Array(sha.Left, sha.Top, _
sha.Left + sha.Width, sha.Top + sha.Height, _
sha.Width, sha.Height)
sha.Select ' выделяем фигуру, которая запустила макрос
End Sub
Комментарии
Отправить комментарий