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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос берет конечные пункты линий не из ячеек а из строк - Мир MS Excel

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

Excel 2013
Доброго времени дня.
Посоветуйте - как поправить макрос.

Макрос проводит линию между двумя пунктами - которые указаны в двух ячейках (Начало и конец)
Сейчас макрос берет названия конечных пунктов линий - из ячеек E3 и E6.

Что поменять в коде, чтобы он брал названия конечных пунктов линий - не из этих двух ячеек, а из всех ячеек в строках 3 и 6 ?
К сообщению приложен файл: 6595580.xls(66.0 Kb)
 
Ответить
СообщениеДоброго времени дня.
Посоветуйте - как поправить макрос.

Макрос проводит линию между двумя пунктами - которые указаны в двух ячейках (Начало и конец)
Сейчас макрос берет названия конечных пунктов линий - из ячеек E3 и E6.

Что поменять в коде, чтобы он брал названия конечных пунктов линий - не из этих двух ячеек, а из всех ячеек в строках 3 и 6 ?

Автор - АлексейАльтман
Дата добавления - 15.11.2018 в 20:28
krosav4ig Дата: Пятница, 16.11.2018, 04:41 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1729
Репутация: 728 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
Можно как-то так
[vba]
Код
Sub Макрос1()
    Dim o1 As Shape, o2 As Shape
    Dim x1!, y1!, r1!, x2!, y2!, r2!, xa!, ya!, xb!, yb!
    Dim col As Range
    For Each col In [A3:E6].Columns
        On Error Resume Next
        Set o1 = ActiveSheet.Shapes(col.Cells(1))
        Set o2 = ActiveSheet.Shapes(col.Cells(4))
        If Not (o1 Is Nothing Or o2 Is Nothing) Then
            GetParam o1, x1, y1, r1
            GetParam o2, x2, y2, r2
            Dim i&, j&, p#, l!, lmin!
            Dim x1t!, y1t!, x2t!, y2t!, bc&, ec&
            p = Atn(1)
            lmin = [a65536].Top - [a1].Top
            For i = 0 To 7
                x1t = x1 + Cos(p * i) * r1
                y1t = y1 - Sin(p * i) * r1
                For j = 0 To 7
                    x2t = x2 + Cos(p * j) * r2
                    y2t = y2 - Sin(p * j) * r2
                    l = Sqr((x1t - x2t) ^ 2 + (y1t - y2t) ^ 2)
                    If l < lmin Then
                        lmin = l
                        xa = x1t
                        ya = y1t
                        xb = x2t
                        yb = y2t
                        bc = i
                        ec = j
                    End If
                Next
            Next
            With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, xa, ya, xb, yb)
                .ConnectorFormat.BeginConnect o1, (bc + 6) Mod 8 + 1
                .ConnectorFormat.EndConnect o2, (ec + 6) Mod 8 + 1
                .Name = col.Cells(1) & "|" & col.Cells(4)
            End With
        End If
    Next
End Sub
[/vba]


(_)Õvõ(_)
 
Ответить
СообщениеЗдравствуйте.
Можно как-то так
[vba]
Код
Sub Макрос1()
    Dim o1 As Shape, o2 As Shape
    Dim x1!, y1!, r1!, x2!, y2!, r2!, xa!, ya!, xb!, yb!
    Dim col As Range
    For Each col In [A3:E6].Columns
        On Error Resume Next
        Set o1 = ActiveSheet.Shapes(col.Cells(1))
        Set o2 = ActiveSheet.Shapes(col.Cells(4))
        If Not (o1 Is Nothing Or o2 Is Nothing) Then
            GetParam o1, x1, y1, r1
            GetParam o2, x2, y2, r2
            Dim i&, j&, p#, l!, lmin!
            Dim x1t!, y1t!, x2t!, y2t!, bc&, ec&
            p = Atn(1)
            lmin = [a65536].Top - [a1].Top
            For i = 0 To 7
                x1t = x1 + Cos(p * i) * r1
                y1t = y1 - Sin(p * i) * r1
                For j = 0 To 7
                    x2t = x2 + Cos(p * j) * r2
                    y2t = y2 - Sin(p * j) * r2
                    l = Sqr((x1t - x2t) ^ 2 + (y1t - y2t) ^ 2)
                    If l < lmin Then
                        lmin = l
                        xa = x1t
                        ya = y1t
                        xb = x2t
                        yb = y2t
                        bc = i
                        ec = j
                    End If
                Next
            Next
            With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, xa, ya, xb, yb)
                .ConnectorFormat.BeginConnect o1, (bc + 6) Mod 8 + 1
                .ConnectorFormat.EndConnect o2, (ec + 6) Mod 8 + 1
                .Name = col.Cells(1) & "|" & col.Cells(4)
            End With
        End If
    Next
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 16.11.2018 в 04:41
АлексейАльтман Дата: Пятница, 16.11.2018, 11:33 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
krosav4ig, все ясно.
Спасибо за совет.


Сообщение отредактировал АлексейАльтман - Пятница, 16.11.2018, 11:53
 
Ответить
Сообщениеkrosav4ig, все ясно.
Спасибо за совет.

Автор - АлексейАльтман
Дата добавления - 16.11.2018 в 11:33
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос берет конечные пункты линий не из ячеек а из строк (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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