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

Вход

Регистрация

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

 

= Мир MS Excel/"Протянуть" SourceData графика средствами VBA - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » "Протянуть" SourceData графика средствами VBA (Макросы/Sub)
"Протянуть" SourceData графика средствами VBA
StoTisteg Дата: Понедельник, 05.04.2021, 20:16 | Сообщение № 1
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Коллеги, у меня есть такая проблема.
На листе есть несколько графиков. При его активации, если наступило "завтра", создаётся новая строка. Результат показан на листе Есть. Необходимо пройтись в цикле по графикам и "протянуть" их SourceData так, чтобы они стали такими, как на листе Нужно.
Проблема в том, что таких листов десятки и не факт, что имена ChartObjects везде одинаковы и везде соответствуют одним и тем же диапазонам.
Проще говоря, мне нужно получить от PlotArea SourceData как Range, а уж написать ActiveChart.SetSourceData Source:=rng я уж как-нибудь сумею :-) Пока родил только такое:
[vba]
Код
Private Sub Worksheet_Activate()

    Dim ch As ChartObject
   
    For Each ch In ActiveSheet.ChartObjects
        ch.Activate
        ActiveChart.PlotArea.Select
        'Здесь нужно протягивать PlotArea
    Next ch

End Sub
[/vba]
К сообщению приложен файл: 6927892.xlsm (24.1 Kb)


Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Понедельник, 05.04.2021, 20:22
 
Ответить
СообщениеКоллеги, у меня есть такая проблема.
На листе есть несколько графиков. При его активации, если наступило "завтра", создаётся новая строка. Результат показан на листе Есть. Необходимо пройтись в цикле по графикам и "протянуть" их SourceData так, чтобы они стали такими, как на листе Нужно.
Проблема в том, что таких листов десятки и не факт, что имена ChartObjects везде одинаковы и везде соответствуют одним и тем же диапазонам.
Проще говоря, мне нужно получить от PlotArea SourceData как Range, а уж написать ActiveChart.SetSourceData Source:=rng я уж как-нибудь сумею :-) Пока родил только такое:
[vba]
Код
Private Sub Worksheet_Activate()

    Dim ch As ChartObject
   
    For Each ch In ActiveSheet.ChartObjects
        ch.Activate
        ActiveChart.PlotArea.Select
        'Здесь нужно протягивать PlotArea
    Next ch

End Sub
[/vba]

Автор - StoTisteg
Дата добавления - 05.04.2021 в 20:16
Pelena Дата: Понедельник, 05.04.2021, 22:22 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19160
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Можно попробовать "достать" адрес диапазона-источника из формулы ряда
[vba]
Код
Sub www()
    Dim addr$, rng As Range
    addr = Split(Split(ActiveChart.SeriesCollection(1).Formula, ",")(2), "!")(1)
    Set rng = Range(addr)
    ActiveChart.SetSourceData rng.Resize(rng.Rows.Count + 1)
End Sub
[/vba]
То есть если на диаграмме несколько рядов, то надо пробежаться по всем


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеМожно попробовать "достать" адрес диапазона-источника из формулы ряда
[vba]
Код
Sub www()
    Dim addr$, rng As Range
    addr = Split(Split(ActiveChart.SeriesCollection(1).Formula, ",")(2), "!")(1)
    Set rng = Range(addr)
    ActiveChart.SetSourceData rng.Resize(rng.Rows.Count + 1)
End Sub
[/vba]
То есть если на диаграмме несколько рядов, то надо пробежаться по всем

Автор - Pelena
Дата добавления - 05.04.2021 в 22:22
StoTisteg Дата: Понедельник, 05.04.2021, 23:07 | Сообщение № 3
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Спасибо, класс hands
Только рядов на некоторых диаграммах действительно несколько. Сначала не придал значения, а теперь ума не хватает сообразить, как пробежаться по всем :confused:
К сообщению приложен файл: 1582620.xlsm (24.3 Kb)


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеСпасибо, класс hands
Только рядов на некоторых диаграммах действительно несколько. Сначала не придал значения, а теперь ума не хватает сообразить, как пробежаться по всем :confused:

Автор - StoTisteg
Дата добавления - 05.04.2021 в 23:07
Pelena Дата: Вторник, 06.04.2021, 07:38 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19160
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Помимо того, что там несколько рядов, надо ещё отдельно изменять диапазон подписей по оси X и имена рядов, иначе они теряются.
Возможно, не самый оптимальный вариант, но пока так получилось
[vba]
Код
Sub www()
    Dim addr$, rng As Range, addrX$, rngX As Range, addr0$, rng0 As Range
    Dim ser As Series
    
    'извлекаем диапазон категорий (ось X)
    addrX = Split(Split(ActiveChart.SeriesCollection(1).Formula, ",")(1), "!")(1)
    
    For Each ser In ActiveChart.SeriesCollection    'для каждого ряда
        'извлекаем и объединяем имена рядов
        addr0 = Split(Split(ser.Formula, ",")(0), "!")(1)
        If rng0 Is Nothing Then Set rng0 = Range(addr0) Else Set rng0 = Union(rng0, Range(addr0))
        
        'извлекаем и объединяем диапазоны рядов
        addr = Split(Split(ser.Formula, ",")(2), "!")(1)
        If rng Is Nothing Then Set rng = Range(addr) Else Set rng = Union(rng, Range(addr))
    Next ser
    'увеличиваем диапазон на 1 строку
    Set rng = rng.Resize(rng.Rows.Count + 1)
    
    'источник данных - объединяем имена рядов и диапазоны рядов
    ActiveChart.SetSourceData Union(rng0, rng)
    
    'увеличиваем на 1 строку диапазон категорий
    Set rngX = Range(addrX)
    Set rngX = rngX.Resize(rngX.Rows.Count + 1)
    'задаём новый диапазон подписей по оси Х
    ActiveChart.SeriesCollection(1).XValues = "=" & ActiveSheet.Name & "!" & rngX.Address
End Sub
[/vba]
К сообщению приложен файл: 1582620_1.xlsm (28.7 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеПомимо того, что там несколько рядов, надо ещё отдельно изменять диапазон подписей по оси X и имена рядов, иначе они теряются.
Возможно, не самый оптимальный вариант, но пока так получилось
[vba]
Код
Sub www()
    Dim addr$, rng As Range, addrX$, rngX As Range, addr0$, rng0 As Range
    Dim ser As Series
    
    'извлекаем диапазон категорий (ось X)
    addrX = Split(Split(ActiveChart.SeriesCollection(1).Formula, ",")(1), "!")(1)
    
    For Each ser In ActiveChart.SeriesCollection    'для каждого ряда
        'извлекаем и объединяем имена рядов
        addr0 = Split(Split(ser.Formula, ",")(0), "!")(1)
        If rng0 Is Nothing Then Set rng0 = Range(addr0) Else Set rng0 = Union(rng0, Range(addr0))
        
        'извлекаем и объединяем диапазоны рядов
        addr = Split(Split(ser.Formula, ",")(2), "!")(1)
        If rng Is Nothing Then Set rng = Range(addr) Else Set rng = Union(rng, Range(addr))
    Next ser
    'увеличиваем диапазон на 1 строку
    Set rng = rng.Resize(rng.Rows.Count + 1)
    
    'источник данных - объединяем имена рядов и диапазоны рядов
    ActiveChart.SetSourceData Union(rng0, rng)
    
    'увеличиваем на 1 строку диапазон категорий
    Set rngX = Range(addrX)
    Set rngX = rngX.Resize(rngX.Rows.Count + 1)
    'задаём новый диапазон подписей по оси Х
    ActiveChart.SeriesCollection(1).XValues = "=" & ActiveSheet.Name & "!" & rngX.Address
End Sub
[/vba]

Автор - Pelena
Дата добавления - 06.04.2021 в 07:38
doober Дата: Вторник, 06.04.2021, 08:48 | Сообщение № 5
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Вот смотрю я на муки и думаю, а почему сразу не сделать динамические диаграммы. или диапазоны с запасом


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

Автор - doober
Дата добавления - 06.04.2021 в 08:48
Pelena Дата: Вторник, 06.04.2021, 08:55 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19160
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Согласна. Даже использование умных таблиц решило бы проблему :)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеСогласна. Даже использование умных таблиц решило бы проблему :)

Автор - Pelena
Дата добавления - 06.04.2021 в 08:55
StoTisteg Дата: Вторник, 06.04.2021, 15:11 | Сообщение № 7
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Кстати, насчёт умных таблиц — это мысль, которая почему-то не зашла мне в голову. А вот диапазон с запасом (которым побывала вся колонка) не работает...


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеКстати, насчёт умных таблиц — это мысль, которая почему-то не зашла мне в голову. А вот диапазон с запасом (которым побывала вся колонка) не работает...

Автор - StoTisteg
Дата добавления - 06.04.2021 в 15:11
doober Дата: Вторник, 06.04.2021, 19:46 | Сообщение № 8
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
вся колонка

Вся колонка-это круто %)
В разумных пределах работает


 
Ответить
Сообщение
вся колонка

Вся колонка-это круто %)
В разумных пределах работает

Автор - doober
Дата добавления - 06.04.2021 в 19:46
StoTisteg Дата: Суббота, 10.04.2021, 15:39 | Сообщение № 9
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
ActiveChart.SeriesCollection(1).XValues = "=" & ActiveSheet.Name & "!" & rngX.Address

Только
[vba]
Код
ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!" & rngX.Address
[/vba]


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщение
ActiveChart.SeriesCollection(1).XValues = "=" & ActiveSheet.Name & "!" & rngX.Address

Только
[vba]
Код
ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!" & rngX.Address
[/vba]

Автор - StoTisteg
Дата добавления - 10.04.2021 в 15:39
Мир MS Excel » Вопросы и решения » Вопросы по VBA » "Протянуть" SourceData графика средствами VBA (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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