Линейный график VBA

[Slavatron1984]

Добрый день... Где то видел в видео обзорах линейный график такого рода...

В строках список товара
В столбцах недельные продажи

Задачка...
При активации ячейки товара показать линейный график
при активизации ячейки другого товара в этом же графике показать линейный график продаж товара .
При выделении 2 (ячеек наименовании товара) , построить 2 линии продаж в одном графике...

Очень понравилось, может у кого то уже есть такого рода... Искал здесь в поиске не нашел ничего подобного... Спасибо

[staniiislav]

Вы что-то вроде такого хотели (выбирайте товары в а7:а22)?
пример 1 -с удалением всех диаграмм и добавление новой
пример 2 - с добавлением новой и дальнейшем ее изменении

правда товар7 не корректно отображаются

[Slavatron1984]

Станислав все работает четко, если бы еще можно было выбрать к примеру товар 1 и товар 5... В графике можно выбирать для сравнения только товар соседний... Хотя для меня этот вариант более чем устраивает... Спасибо за помощь Очень нужный для логистов график...

[Slavatron1984]

Да 7 строка не работает... Жаль

[Slavatron1984]

Заработал и строка 7-го товара

[staniiislav]

Сообщение от Slavatron1984

Заработал и строка 7-го товара

Благодаря данной статье и соответственно автору The_Prist
статья:
http://www.excel-vba.ru/chto-umeet-e...-lyuboj-knige/

получилось вот такое чудо

[staniiislav]

даже чет я перемудрил совсем (наверное и не правильно сделать в добавок )
Этого будет достаточно (в модуль листа поместить):

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A7:A22")) Is Nothing Then
    Dim r As Range, rD As Range
    Dim IChart, n&
    Set rD = Range("A7:P22")
    Set r = Intersect(rD, Target.EntireRow)
    For Each IChart In ChartObjects
        If IChart.Name = "д1" Then n = 1: Exit For
    Next
    If Not n = 1 Then
        Application.ScreenUpdating = False
        ActiveSheet.Shapes.AddChart.Select
        ActiveChart.Parent.Name = "д1"
        ActiveChart.ChartType = xlLineMarkers
        ActiveChart.SetSourceData Source:=r
        ActiveChart.SeriesCollection(1).XValues = Range("недели2").Value
        ActiveChart.ChartType = xlLineMarkers
        Application.ScreenUpdating = True
    Else
        With ChartObjects("д1").Chart
            .SetSourceData Source:=r
            .SeriesCollection(1).XValues = Range("недели2").Value
            .ChartType = xlLineMarkers
        End With
    End If
End If
End Sub

[Slavatron1984]

Спасибо Все Супер... Только не могу последним примером воспользоваться при копировании кода русские буквы меняются на вопросительный знак и изменить вручную не дает русскими.. У меня офис 2013... Но предпоследний пример меня устраивает в полном объеме...Спасибо

[staniiislav]

Сообщение от Slavatron1984

Спасибо Все Супер... Только не могу последним примером воспользоваться при копировании кода русские буквы меняются на вопросительный знак и изменить вручную не дает русскими.. У меня офис 2013... Но предпоследний пример меня устраивает в полном объеме...Спасибо

странно... вот пример с последним кодом