Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Построение диаграммы из диапазона активного листа
 
#1
05.03.2024 09:59:51
Всех приветствую!
Прошу помощи с задачей построения диаграммы в VBA. Есть множество листов, в каждом диапазоны в тех же ячейках, на основании которых строятся диаграммы. В каждой диаграмме несколько рядом (например, 3) со своими значениями Х и Y. Проблема в том, чтобы диаграмма строилась по значениям из диапазона активного листа. Сейчас получилось только добиться того, чтобы на всех листа данные диаграммы брались из первого листа.
У меня указаны именованные диапазоны, но это непринципиально. Я пытался через них решить проблему.

Sub Grafik_excel()

For intCount = 1 To Cells(1, 1)

ActiveSheet.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select

Dim xRg As Range
Dim xChart As ChartObject

Set xRg = Range("B5:M20")
Set xChart = ActiveSheet.ChartObjects(1)
With xChart
.Top = xRg(1).Top
.Left = xRg(1).Left
.Width = xRg.Width
.Height = xRg.Height
End With

xChart.Activate
'данные для построения графиков
   Application.CutCopyMode = False
   ActiveChart.SeriesCollection.NewSeries
   ActiveChart.FullSeriesCollection(1).XValues = "=Шаблон!Расход1"
   ActiveChart.FullSeriesCollection(1).Values = "=Шаблон!Напор1"
   ActiveChart.SeriesCollection.NewSeries
   ActiveChart.FullSeriesCollection(2).XValues = "=Шаблон!Расход2"
   ActiveChart.FullSeriesCollection(2).Values = "=Шаблон!Напор2"
       ActiveChart.SeriesCollection.NewSeries
   ActiveChart.FullSeriesCollection(3).XValues = "=Шаблон!Расход3"
   ActiveChart.FullSeriesCollection(3).Values = "=Шаблон!Напор3"
   
With ActiveChart
   .HasTitle = True
   .ChartTitle.Characters.Text = Range("b57")
    'подпись - горизонтальная ось
   .Axes(xlCategory, xlPrimary).HasTitle = True
   .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Range("AH2")
    'подпись - вертикальная ось
   .Axes(xlValue, xlPrimary).HasTitle = True
   .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range("AH3")
End With

ActiveSheet.Next.Select
 
Next

End Sub
Изменено: Lexey - 05.03.2024 10:06:37
 
 
 
#2
05.03.2024 10:21:58
Без файл примера, навскидку
Код
ActiveChart.FullSeriesCollection(1).XValues= "='" & ActiveSheet.Name & "'!A1:A10"
ActiveChart.FullSeriesCollection(1).Values= "='" & ActiveSheet.Name & "'!B1:B10"
Диапазоны свои вставите, с другими рядами по аналогии
 
 
 
#3
05.03.2024 10:48:00
Цитата
написал:
Без файл примера, навскидкуКодActiveChart.FullSeriesCollection(1).XValues= "='" & ActiveSheet.Name & "'!A1:A10"
ActiveChart.FullSeriesCollection(1).Values= "='" & ActiveSheet.Name & "'!B1:B10"
Диапазоны свои вставите, с другими рядами по аналогии
Не работает.
Файл прикладываюДиаграмма VBA на каждом листе.xlsm (18.39 КБ)
 
 
 
#4
05.03.2024 11:56:17
Код
Sub Grafik_excel()
    Dim ws          As Worksheet
    Dim xRg         As Range
    Dim xChart      As ChartObject
    For Each ws In Worksheets    'для каждого листа
        ws.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
        Set xRg = Range("B5:M20")
        Set xChart = ws.ChartObjects(1)
        With xChart
            .Top = xRg(1).Top
            .Left = xRg(1).Left
            .Width = xRg.Width
            .Height = xRg.Height
        End With
        With xChart.Chart
            'данные для построения графиков
            .SeriesCollection.NewSeries
            .FullSeriesCollection(1).XValues = "='" & ws.Name & "'!$N$2:$X$2"
            .FullSeriesCollection(1).Values = "='" & ws.Name & "'!$N$3:$X$3"
            .SeriesCollection.NewSeries
            .FullSeriesCollection(2).XValues = "='" & ws.Name & "'!$N$4:$X$4"
            .FullSeriesCollection(2).Values = "='" & ws.Name & "'!$N$5:$X$5"
            .SeriesCollection.NewSeries
            .FullSeriesCollection(3).XValues = "='" & ws.Name & "'!$N$6:$X$6"
            .FullSeriesCollection(3).Values = "='" & ws.Name & "'!$N$7:$X$7"
        End With
    Next
End Sub
 
 
 
#5
06.03.2024 10:18:00
Спасибо, всё заработало!

А как можно задать те листы, на которых необходимо выполнить макрос? В книге есть листы, на которых не нужно строить диаграмму. Что-то вроде этого

For intCount = 1 To Cells(1, 1)

Возможно, написал чушь, т.к. недавно начал изучение vba.
 
 
 
#6
06.03.2024 14:17:51
Добавить в код массив названиями листов, на которых не надо строить график:
Код
Sub Grafik_excel()
    Dim ws          As Worksheet
    Dim xRg         As Range
    Dim xChart      As ChartObject
    ListIkl = Array("Лист3", "Лист4")    'листы, которые нужно исключить
    For Each ws In Worksheets    'для каждого листа
        If Not IsNumeric(Application.Match(ws.Name, ListIkl, 0)) Then
            ws.Shapes.AddChart2(240, xlXYScatterSmoothNoMarkers).Select
            Set xRg = Range("B5:M20")
            Set xChart = ws.ChartObjects(1)
            With xChart
                .Top = xRg(1).Top
                .Left = xRg(1).Left
                .Width = xRg.Width
                .Height = xRg.Height
            End With
            With xChart.Chart
                'данные для построения графиков
                .SeriesCollection.NewSeries
                .FullSeriesCollection(1).XValues = "='" & ws.Name & "'!$N$2:$X$2"
                .FullSeriesCollection(1).Values = "='" & ws.Name & "'!$N$3:$X$3"
                .SeriesCollection.NewSeries
                .FullSeriesCollection(2).XValues = "='" & ws.Name & "'!$N$4:$X$4"
                .FullSeriesCollection(2).Values = "='" & ws.Name & "'!$N$5:$X$5"
                .SeriesCollection.NewSeries
                .FullSeriesCollection(3).XValues = "='" & ws.Name & "'!$N$6:$X$6"
                .FullSeriesCollection(3).Values = "='" & ws.Name & "'!$N$7:$X$7"
            End With
        End If
    Next
End Sub
 
 
 
Страницы: 1
Наверх