☰

使用 vba 在单独的工作表中创建 excel 图表

tag-icon • tag-icon microsoft-excel vba charts microsoft-excel-2016
使用 vba 在单独的工作表中创建 excel 图表

在 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

不确定这是否对任何人都有用，但这是我最终得到的最终代码：

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

显然，这可能不会直接适用于其他人的项目，但希望其中的部分内容能够有所帮助，因为代码包括打开文件和为这些文件中的工作表创建对象

相关内容