В Excel 2016 я пытаюсь написать подпрограмму vba, которая берет лист, содержащий некоторые данные, и создает новый лист, который будет заполнен диаграммами, использующими данные в исходном листе.

Я записал несколько макросов и попытался использовать это для написания своего кода. До сих пор мне удавалось создавать диаграммы на одном листе с данными, расположенными друг над другом.

Я хотел бы, чтобы диаграммы заполняли отдельную страницу и чтобы они были каким-то образом разнесены, чтобы они не блокировали друг друга. Я считаю, что это будет включать в себя не использовать ActiveSheet, который обычно использует макро-рекордер.

Я разместил свой код ниже и был бы признателен за любую помощь.

Private Sub CommandButton2_Click()
'Measure A pair for A signal
Range("A:A,B:B,C:C,D:D,E:E").Select
    Range("E1").Activate
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range( _
        "TEST!$B:$B,TEST!$C:$C,TEST!$D:$D,TEST!$E:$E")
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).XValues = "=TEST!$A2:$A1179"
'Measure B pair for A signal
Range("A:A,B:B,C:C,D:D,E:E").Select
    Range("E1").Activate
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range( _
        "TEST!$F:$F,TEST!$G:$G,TEST!$H:$H,TEST!$I:$I")
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).XValues = "=TEST!$A2:$A1179"
End Sub

Лист с данными называется "ТЕСТ"

|источник

1 ответ1

0

Не уверен, будет ли это кому-нибудь полезно, но вот мой последний код, с которым я закончил:

Private Sub GraphButton1_Click()

Dim lngcount As Long
Dim filePath As String
Dim file_array As New Collection
'Open the file dialog'
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Show

    'Display paths of each file selected'
    For lngcount = 1 To .SelectedItems.Count
        filePath = .SelectedItems(lngcount)
        If Dir(filePath) <> "" Then
            Workbooks.Open (filePath)
            file_array.Add filePath
        End If
    Next lngcount
End With

Dim f As Variant
For Each f In file_array


'fileName is filename plus extension'
Filename = Dir(f)

'Create Workbook Object for TEST_DATA'
Dim wb As Workbook
Set wb = Application.Workbooks(Filename)

'wsName is fileName without extension'
Dim wsName As String
wsName = Left(Filename, Len(Filename) - 4)

'Create Worksheet Object for TEST'
Dim ws As Worksheet
Set ws = wb.Worksheets(wsName)
'Add chartsheet to workbook and create Worksheet Object for chartsheet'
wb.Worksheets.Add().Name = "chartsheet"
Dim chartsheet As Worksheet
Set chartsheet = wb.Worksheets("chartsheet")

'Measure A pair for A signal'
Dim chart1 As Chart
Set chart1 = chartsheet.Shapes.AddChart2.Chart

With chart1
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets(wsName).Range("$B:$B,$C:$C,$D:$D,$E:$E")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "A pair for A signal"
    .HasLegend = True
    .ChartArea.Left = 10
    .ChartArea.Top = 10
End With

'Measure B pair for A signal'
Dim chart2 As Chart
Set chart2 = chartsheet.Shapes.AddChart2.Chart
With chart2
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets(wsName).Range("$F:$F,$G:$G,$H:$H,$I:$I")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "B pair for A signal"
    .HasLegend = True
    .ChartArea.Left = 380
    .ChartArea.Top = 10
End With

'Measure C pair for A signal'
Dim chart3 As Chart
Set chart3 = chartsheet.Shapes.AddChart2.Chart
With chart3
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets(wsName).Range("$J:$J,$K:$K,$L:$L,$M:$M")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "C pair for A signal"
    .HasLegend = True
    .ChartArea.Left = 750
    .ChartArea.Top = 10
End With

'Measure D pair for A signal'
Dim chart4 As Chart
Set chart4 = chartsheet.Shapes.AddChart2.Chart
With chart4
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets(wsName).Range("$N:$N,$O:$O,$P:$P,$Q:$Q")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "D pair for A signal"
    .HasLegend = True
    .ChartArea.Left = 1120
    .ChartArea.Top = 10
End With

'Measure B pair for B signal'
Dim chart5 As Chart
Set chart5 = chartsheet.Shapes.AddChart2.Chart
With chart5
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$AN:$AN,$AO:$AO,$AP:$AP,$AQ:$AQ")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "B pair for B signal"
    .HasLegend = True
    .ChartArea.Left = 10
    .ChartArea.Top = 240
End With

'Measure A pair for B signal'
Dim chart6 As Chart
Set chart6 = chartsheet.Shapes.AddChart2.Chart
With chart6
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$AJ:$AJ,$AK:$AK,$AL:$AL,$AM:$AM")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "A pair for B signal"
    .HasLegend = True
    .ChartArea.Left = 380
    .ChartArea.Top = 240
End With

'Measure C pair for B signal'
Dim chart7 As Chart
Set chart7 = chartsheet.Shapes.AddChart2.Chart
With chart7
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$AR:$AR,$AS:$AS,$AT:$AT,$AU:$AU")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "C pair for B signal"
    .HasLegend = True
    .ChartArea.Left = 750
    .ChartArea.Top = 240
End With

'Measure D pair for B signal'
Dim chart8 As Chart
Set chart8 = chartsheet.Shapes.AddChart2.Chart
With chart8
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$AV:$AV,$AW:$AW,$AX:$AX,$AY:$AY")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "D pair for B signal"
    .HasLegend = True
    .ChartArea.Left = 1120
    .ChartArea.Top = 240
End With

'Measure C pair for C signal'
Dim chart9 As Chart
Set chart9 = chartsheet.Shapes.AddChart2.Chart
With chart9
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$BZ:$BZ,$CA:$CA,$CB:$CB,$CC:$CC")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "C pair for C signal"
    .HasLegend = True
    .ChartArea.Left = 10
    .ChartArea.Top = 470
End With

'Measure A pair for C signal'
Dim chart10 As Chart
Set chart10 = chartsheet.Shapes.AddChart2.Chart
With chart10
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$BR:$BR,$BS:$BS,$BT:$BT,$BU:$BU")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "A pair for C signal"
    .HasLegend = True
    .ChartArea.Left = 380
    .ChartArea.Top = 470
End With

'Measure B pair for C signal'
Dim chart11 As Chart
Set chart11 = chartsheet.Shapes.AddChart2.Chart
With chart11
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$BV:$BV,$BW:$BW,$BX:$BX,$BY:$BY")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "B pair for C signal"
    .HasLegend = True
    .ChartArea.Left = 750
    .ChartArea.Top = 470
End With

'Measure D pair for C signal'
Dim chart12 As Chart
Set chart12 = chartsheet.Shapes.AddChart2.Chart
With chart12
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$CD:$CD,$CE:$CE,$CF:$CF,$CG:$CG")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "D pair for C signal"
    .HasLegend = True
    .ChartArea.Left = 1120
    .ChartArea.Top = 470
End With

'Measure D pair for D signal'
Dim chart13 As Chart
Set chart13 = chartsheet.Shapes.AddChart2.Chart
With chart13
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$DL:$DL,$DM:$DM,$DN:$DN,$DO:$DO")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "D pair for D signal"
    .HasLegend = True
    .ChartArea.Left = 10
    .ChartArea.Top = 700
End With

'Measure A pair for D signal'
Dim chart14 As Chart
Set chart14 = chartsheet.Shapes.AddChart2.Chart
With chart14
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$CZ:$CZ,$DA:$DA,$DB:$DB,$DC:$DC")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "A pair for D signal"
    .HasLegend = True
    .ChartArea.Left = 380
    .ChartArea.Top = 700
End With

'Measure B pair for D signal'
Dim chart15 As Chart
Set chart15 = chartsheet.Shapes.AddChart2.Chart
With chart15
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$DD:$DD,$DE:$DE,$DF:$DF,$DG:$DG")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "B pair for D signal"
    .HasLegend = True
    .ChartArea.Left = 750
    .ChartArea.Top = 700
End With

'Measure C pair for D signal'
Dim chart16 As Chart
Set chart16 = chartsheet.Shapes.AddChart2.Chart
With chart16
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$DH:$DH,$DI:$DI,$DJ:$DJ,$DK:$DK")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "C pair for D signal"
    .HasLegend = True
    .ChartArea.Left = 1120
    .ChartArea.Top = 700
End With



Next f

End Sub

Очевидно, что это, вероятно, не будет напрямую применимо к проектам других людей, но, надеюсь, его части могут быть полезны, поскольку код включает в себя открытие файлов и создание объектов для рабочих листов в этих файлах.

|источник

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .