Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Рисование параллельной линии, определенного размера - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Рисование параллельной линии, определенного размера (Макросы/Sub)
Рисование параллельной линии, определенного размера
SergVrn Дата: Суббота, 28.10.2017, 09:15 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Доброе утро.
Помогите новичку с решением.

У меня есть макрос, рисующий линию между двумя точками.

Как заставить этот макрос - также начертить еще линию, длиной = 200, параллельную основной нарисованной линии ?
К сообщению приложен файл: 8845378.xls(46Kb)
 
Ответить
СообщениеДоброе утро.
Помогите новичку с решением.

У меня есть макрос, рисующий линию между двумя точками.

Как заставить этот макрос - также начертить еще линию, длиной = 200, параллельную основной нарисованной линии ?

Автор - SergVrn
Дата добавления - 28.10.2017 в 09:15
Roman777 Дата: Суббота, 28.10.2017, 12:55 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 798
Репутация: 89 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
SergVrn, Доброе, например:

[vba]
Код
Sub ЕщёМакрос()
Dim X1#, Y1#, X2#, Y2#
Dim X1_II#, Y1_II#, X2_II#, Y2_II#
Dim dlina#, dlin_#

dlina = 200
smeshX = Cells(1, 1).Width 'Смещение параллельной линии по Х
smeshY = Cells(1, 1).Height 'Смещение параллельной линии по Y
X1 = Cells(5, 6)
Y1 = Cells(6, 5)
X2 = Cells(5, 10)
Y2 = Cells(6, 9)
dlin_ = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
X1_II = X1 + smeshX
Y1_II = Y1 + smeshY
X2_II = ((X2 - X1) * dlina / dlin_) + X1 + smeshX
Y2_II = ((Y2 - Y1) * dlina / dlin_) + Y1 + smeshY

Set lineA = ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Line
Set lineB = ActiveSheet.Shapes.AddLine(X1_II, Y1_II, X2_II, Y2_II).Line
lineB.DashStyle = msoLineDash 'msoLineDashDotDot

lineA.ForeColor.RGB = RGB(0, 0, 255)
lineB.ForeColor.RGB = RGB(255, 0, 0)
End Sub
[/vba]


Много чего не знаю!!!!
 
Ответить
СообщениеSergVrn, Доброе, например:

[vba]
Код
Sub ЕщёМакрос()
Dim X1#, Y1#, X2#, Y2#
Dim X1_II#, Y1_II#, X2_II#, Y2_II#
Dim dlina#, dlin_#

dlina = 200
smeshX = Cells(1, 1).Width 'Смещение параллельной линии по Х
smeshY = Cells(1, 1).Height 'Смещение параллельной линии по Y
X1 = Cells(5, 6)
Y1 = Cells(6, 5)
X2 = Cells(5, 10)
Y2 = Cells(6, 9)
dlin_ = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
X1_II = X1 + smeshX
Y1_II = Y1 + smeshY
X2_II = ((X2 - X1) * dlina / dlin_) + X1 + smeshX
Y2_II = ((Y2 - Y1) * dlina / dlin_) + Y1 + smeshY

Set lineA = ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Line
Set lineB = ActiveSheet.Shapes.AddLine(X1_II, Y1_II, X2_II, Y2_II).Line
lineB.DashStyle = msoLineDash 'msoLineDashDotDot

lineA.ForeColor.RGB = RGB(0, 0, 255)
lineB.ForeColor.RGB = RGB(255, 0, 0)
End Sub
[/vba]

Автор - Roman777
Дата добавления - 28.10.2017 в 12:55
SergVrn Дата: Воскресенье, 29.10.2017, 05:35 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 25
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Roman777, все работает. Спасибо за код.
 
Ответить
СообщениеRoman777, все работает. Спасибо за код.

Автор - SergVrn
Дата добавления - 29.10.2017 в 05:35
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Рисование параллельной линии, определенного размера (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!