Коллеги, у меня есть такая проблема. На листе есть несколько графиков. При его активации, если наступило "завтра", создаётся новая строка. Результат показан на листе Есть. Необходимо пройтись в цикле по графикам и "протянуть" их 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]
Коллеги, у меня есть такая проблема. На листе есть несколько графиков. При его активации, если наступило "завтра", создаётся новая строка. Результат показан на листе Есть. Необходимо пройтись в цикле по графикам и "протянуть" их 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
Можно попробовать "достать" адрес диапазона-источника из формулы ряда [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] То есть если на диаграмме несколько рядов, то надо пробежаться по всем
Можно попробовать "достать" адрес диапазона-источника из формулы ряда [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
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Спасибо, класс Только рядов на некоторых диаграммах действительно несколько. Сначала не придал значения, а теперь ума не хватает сообразить, как пробежаться по всем :confused:
Спасибо, класс Только рядов на некоторых диаграммах действительно несколько. Сначала не придал значения, а теперь ума не хватает сообразить, как пробежаться по всем :confused:StoTisteg
Помимо того, что там несколько рядов, надо ещё отдельно изменять диапазон подписей по оси X и имена рядов, иначе они теряются. Возможно, не самый оптимальный вариант, но пока так получилось [vba]
Код
Sub www() Dim addr$, rng As Range, addrX$, rngX As Range, addr0$, rng0 As Range Dim ser As Series
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]
Помимо того, что там несколько рядов, надо ещё отдельно изменять диапазон подписей по оси X и имена рядов, иначе они теряются. Возможно, не самый оптимальный вариант, но пока так получилось [vba]
Код
Sub www() Dim addr$, rng As Range, addrX$, rngX As Range, addr0$, rng0 As Range Dim ser As Series
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
Кстати, насчёт умных таблиц — это мысль, которая почему-то не зашла мне в голову. А вот диапазон с запасом (которым побывала вся колонка) не работает...
Кстати, насчёт умных таблиц — это мысль, которая почему-то не зашла мне в голову. А вот диапазон с запасом (которым побывала вся колонка) не работает...StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.