使用excel vba从多个工作表创建图表

时间:2016-02-25 19:14:38

标签: excel-vba excel-charts vba excel

我试图在列表'数据'上创建一个包含一个系列的图表。该系列的值在wokrbook中的不同表格上(例如AH141023000002.CSV,AH141024000003.CSV,...)。

创建图表代码:

         Sheets("Data").Select
         ActiveSheet.ChartObjects(1).Activate
        ActiveChart.SeriesCollection.Extend _
        Source:=Worksheets("AH141023000002.CSV").Range("D3:D1000")

扩展seriescollection的代码:

Sub Chart_prepdata(quantityadress As String, UsOp As String)
Dim xWs As Worksheet
Dim clstart
Dim clstop 
clstart = 1
clstop = 0
Dim Xn

Sheets("aux").Delete
Worksheets.Add(Before:=Worksheets("Template")).Name = "aux"
Sheets("aux").Visible = True

For Each xWs In Application.ActiveWorkbook.Worksheets
    If xWs.Name <> "Template" And xWs.Name <> "Data" And xWs.Name <> "aux" Then
        Xn = Sheets(xWs.Name).Range(quantityadress & Sheets(xWs.Name).Rows.Count).End(xlUp).Row
    'MsgBox (Xn)
    Sheets(xWs.Name).Select
    clstop = clstop + Xn - 2
    '__________________________________________
    'y axis data
    Worksheets(xWs.Name).Range(quantityadress & "3:" & quantityadress & Xn).Copy _
    Destination:=Worksheets("aux").Range("D" & clstart & ":D" & clstop)
    '__________________________________________
    'x axis data
    Worksheets(xWs.Name).Range("A3:A" & Xn).Copy _
    Destination:=Worksheets("aux").Range("A" & clstart & ":A" & clstop)

    clstart = clstop + 1
    temp_var4 = xWs.Name
End If
Next


Call DrawChart(UsOp, quantityadress, clstop)
Sheets("aux").Visible = False

End Sub

这部分不起作用。没有错误,但没有做任何事情。当我尝试在第一个代码中添加来自相同源范围的数据作为原始图表范围时,一切顺利......但当然具有相同的数据。那么我如何从不同的表单数据中扩展seriescollection?会很高兴得到任何帮助。

.EDIT - 感谢Scott Holtzman。代码并不完美,但对我来说效果很好。

准备隐藏表'aux'的数据:

Sub DrawChart(UsOp As String, quantityadress As String, clstop)
Dim Xn
Xn = clstop / 5 'number of thicklabels = 5

Sheets("Data").Select
With ActiveSheet.ChartObjects("CSV_Graf1")
        With .Chart
        .ChartType = xlLine
        .SetSourceData Source:=Range("'aux'!D:D")
        .SeriesCollection(1).XValues = Range("'aux'!A:A")
        .Axes(xlCategory).TickLabelSpacing = Xn
        End With
End With
    Sheets("aux").Visible = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    ActiveSheet.EnableCalculation = True

End Sub

...和图表代码:

{{1}}

0 个答案:

没有答案