И снова обращаюсь к знатокам Excel (VBA). Нарисовал линию между двумя заданными ячейками (из центра одной в центр соответственно второй). Рисует в любом направлении. Но все это дело не получается вложить в цикл с условием. Необходимо в заданном диапазоне нарисовать линии между всеми ячейками, значения в которых больше 0 (макросом). В примере работающий макрос рисует линию. Свою неудачную 2-х дневную "кашу" из for и if не выкладываю, чтобы не вводить в заблуждение...
[vba]
Код
Sub Draw1Line()
Dim StartCell As Range Dim EndCell As Range Dim Line As Shape
Set StartCell = ThisWorkbook.Sheets("Лист1").Range("E5") Set EndCell = ThisWorkbook.Sheets("Лист1").Range("A3")
With Line .Line.Weight = 3 .Line.DashStyle = msoLineSolid .Line.ForeColor.RGB = RGB(255, 0, 0) End With
End Sub
[/vba]
И снова обращаюсь к знатокам Excel (VBA). Нарисовал линию между двумя заданными ячейками (из центра одной в центр соответственно второй). Рисует в любом направлении. Но все это дело не получается вложить в цикл с условием. Необходимо в заданном диапазоне нарисовать линии между всеми ячейками, значения в которых больше 0 (макросом). В примере работающий макрос рисует линию. Свою неудачную 2-х дневную "кашу" из for и if не выкладываю, чтобы не вводить в заблуждение...
[vba]
Код
Sub Draw1Line()
Dim StartCell As Range Dim EndCell As Range Dim Line As Shape
Set StartCell = ThisWorkbook.Sheets("Лист1").Range("E5") Set EndCell = ThisWorkbook.Sheets("Лист1").Range("A3")
Sub Draw1Line() Dim U As Range Dim I1 As Long, I2 As Long Set U = ActiveSheet.UsedRange For I1 = 1 To U.Count - 1 If U(I1) > 0 Then For I2 = I1 + 1 To U.Count If U(I2) > 0 Then With ActiveSheet.Shapes.AddLine(U(I1).Left + U(I1).Width / 2, U(I1).Top + U(I1).Height / 2, U(I2).Left + U(I2).Width / 2, U(I2).Top + U(I2).Height / 2) .Line.Weight = 1 '3 .Line.DashStyle = msoLineSolid .Line.ForeColor.RGB = RGB(255, 0, 0) End With End If Next I2 End If Next I1 End Sub
[/vba]
[vba]
Код
Sub Draw1Line() Dim U As Range Dim I1 As Long, I2 As Long Set U = ActiveSheet.UsedRange For I1 = 1 To U.Count - 1 If U(I1) > 0 Then For I2 = I1 + 1 To U.Count If U(I2) > 0 Then With ActiveSheet.Shapes.AddLine(U(I1).Left + U(I1).Width / 2, U(I1).Top + U(I1).Height / 2, U(I2).Left + U(I2).Width / 2, U(I2).Top + U(I2).Height / 2) .Line.Weight = 1 '3 .Line.DashStyle = msoLineSolid .Line.ForeColor.RGB = RGB(255, 0, 0) End With End If Next I2 End If Next I1 End Sub
Огромное Вам человеческое спасибо. Благодарю) Я то пытался все через 1 цикл сделать. Задача решена... а мелочи под себя допилить можно и самому
Огромное Вам человеческое спасибо. Благодарю) Я то пытался все через 1 цикл сделать. Задача решена... а мелочи под себя допилить можно и самому Любитель5186
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
