Найти геометрический центр диапазона

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Найти геометрический центр диапазона (Макросы/Sub)

pechkin

Дата: Суббота, 13.01.2018, 14:17 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 332

Репутация: 49 ±

Замечаний: 0% ±

2003

Здравствуйте! Всех с наступающим Старым Новым годом! Подскажите, возможно ли средствами Ексель найти геометрический центр в заданном диапазоне с разной шириной строк и столбцов и каким-либо образом его отметить? Спасибо!

К сообщению приложен файл: 3095975.xls (14.5 Kb)

Ответить

RAN

Дата: Суббота, 13.01.2018, 14:57 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

Sub Макрос1()
    Dim x#, y#
    x = ([i1].Left - [a1].Left - 10) / 2
    y = ([a32].Top - [a1].Top - 10) / 2 '
    ActiveSheet.Shapes.AddShape(msoShapeFlowchartOr, x, y, 10, 10).Select
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

pechkin

Дата: Суббота, 13.01.2018, 15:50 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 332

Репутация: 49 ±

Замечаний: 0% ±

2003

RAN, спасибо! В файле в ячейке A1 указан диапазон, который может быть изменен для нахождения центра. Попробую сам подправить,если получится. Еще раз спасибо!

Ответить

doober

Дата: Воскресенье, 14.01.2018, 01:41 | Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 995

Репутация: 345 ±

Замечаний: 0% ±

Excel 2010

Так для переменного диапазона.[vba]

Код

Sub Центр()
    Dim R As Range
    With ActiveSheet
        Set R = .Range(ActiveSheet.Range("A1").Value)
        H = R.Height / 2
        W = R.Width / 2
        .Shapes.AddShape(msoShapeFlowchartOr, W - 5, H - 5, 10, 10).Select
    End With
End Sub

[/vba]

Сообщение отредактировал doober - Воскресенье, 14.01.2018, 01:42

Ответить

Найти геометрический центр диапазона (Макросы/Sub)

Страница 1 из 1
1