Добавление фигуры(линии) на график

Дата: Пятница, 06.06.2014, 17:17 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

Добрый день! Суть проблемы: нужно на большом количестве однотипных графиков расположить вертикальную красную линию.

Сделал следующий макрос:
[vba]

Код

Sub PaintLine(Right As Integer)
       Dim ws As Integer
       For ws = 1 To Worksheets.Count
           Worksheets(ws).Activate
           Dim gr As Integer
           For gr = 1 To ActiveSheet.ChartObjects.Count
               ActiveSheet.ChartObjects(gr).Activate
               diagTop = ActiveChart.PlotArea.Top
               diagHg = ActiveChart.PlotArea.Height
               ActiveChart.Shapes.AddConnector(msoConnectorStraight, Right, diagTop, Right, diagTop + diagHg).Select
               With Selection.ShapeRange.Line
                   .Visible = msoTrue
                   .ForeColor.RGB = RGB(255, 0, 0)
                   .Weight = 2.5
               End With
           Next gr
       Next ws
End Sub

[/vba]

Линию рисует, но не тех размеров(как на рисунке ниже).
Из каких параметров можно получить расстояния отмеченные на рисунке? Или можно сделать как-то по-другому?

Сообщение отредактировал igemon - Пятница, 06.06.2014, 17:19

Дата: Пятница, 06.06.2014, 22:06 | Сообщение № 2

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

попробуйте так:
[vba]

Код

Sub PaintLine(Right#)
Dim gr As Long, ws As Long
For ws = 1 To Worksheets.Count
     With Worksheets(ws)
         For gr = 1 To .ChartObjects.Count
             With .ChartObjects(gr).Chart
                 With .Shapes.AddConnector(msoConnectorStraight, Right, .PlotArea.Top, Right, .Axes(xlCategory).Top)
                     .Line.ForeColor.RGB = RGB(255, 0, 0)
                     .Line.Weight = 2.5
                 End With
             End With
         Next gr
     End With
Next ws
End Sub

[/vba]

Дата: Понедельник, 09.06.2014, 14:44 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

nilem, спасибо c нижней границей получилось, а вот сверху нет:(

Дата: Понедельник, 09.06.2014, 15:21 | Сообщение № 4

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

а так:
[vba]

Код

Sub PaintLine(Right#)
Dim gr As Long, ws As Long
For ws = 1 To Worksheets.Count
     With Worksheets(ws)
         For gr = 1 To .ChartObjects.Count
             With .ChartObjects(gr).Chart
                 With .Shapes.AddConnector(msoConnectorStraight, Right, .Axes(xlValue).Top, Right, .Axes(xlCategory).Top)
                     .Line.ForeColor.RGB = RGB(255, 0, 0)
                     .Line.Weight = 2.5
                 End With
             End With
         Next gr
     End With
Next ws
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Дата: Понедельник, 09.06.2014, 15:47 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

nilem, спасибо, работает

Вот еще вопрос, я передаю смещение по оси X параметром (предварительно подобрав на глаз на каком-нибудь графике).

Хотелось бы сделать это через передачу значения с оси X, а не количеством точек от края документа,
т.е. я передаю параметр "0:20", он находит это значение на графике(на горизонтальной оси) и рисует линию там.

Возможно ли это? Если да, то куда копать?)

Дата: Понедельник, 09.06.2014, 16:22 | Сообщение № 6

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

Копать, скорее всего, в сторону Points (от сих и до обеда :))
Примерчик бы в файле...

Яндекс.Деньги 4100159601573

Дата: Понедельник, 09.06.2014, 16:46 | Сообщение № 7

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

Вот пример, как это выглядит сейчас

К сообщению приложен файл: example.xlsm (23.5 Kb)

Дата: Понедельник, 09.06.2014, 17:21 | Сообщение № 8

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

Выбираемое время должно точно соответствовать значениям на оси абсцисс или может находиться где-то м/у делениями?

Яндекс.Деньги 4100159601573

Дата: Понедельник, 09.06.2014, 17:30 | Сообщение № 9

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

Время может быть равно любому значению из интервала, по которому построен график.

В примере интервал между делениями - 2, поэтому тут, если выбрать "0:05" то будет м/у делениями, если бы интервал был 1, то только на делениях.

Дата: Понедельник, 09.06.2014, 19:00 | Сообщение № 10

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

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

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

Excel 2013, 2016

Пришлось задействовать Джона нашего Уокенбаха

см. файл

К сообщению приложен файл: _Points_example.xlsm (31.5 Kb)

Яндекс.Деньги 4100159601573

Дата: Вторник, 10.06.2014, 15:06 | Сообщение № 11

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

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

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

Excel 2013

Спасибо, на этом конкретном примере все работает, но возникла проблема на других данных.

В месте где сравнивается искомое время с временем из диапазона

[vba]

Код

     dt = .Range("A1").Value
     For i = 1 To UBound(x)
         If x(i, 1) = dt Then Exit For
     Next i
     If i > UBound(x) Then MsgBox "Time is not found": Exit Sub

[/vba]

Условие не срабатывает хотя значения равны. Я решил приводить время к строке и сравнивать строки, так вроде работает.