从不同表格自动绘制图表

时间:2013-03-25 14:49:51

标签: vba graph

我正在编写一个excel应用程序,它从表格中获取信息(它也是编程的,每个表格的长度和位置都可以改变)并为其他工作表中的每个表格生成一个图形,称为Estimation Sheet,当a按钮是按下。

我设法为第一个graphich(对应于第一个表)执行此任务但是当我尝试对第二个使用相同的方法时......它不起作用。这是用于绘制第一个图形的方法:

    Public Sub generateGraphicsC(RowResistiveC As Integer)

       Dim FirstRow As Integer, FirstColumn As Integer, LastRow As Integer, LastColumn As Integer,         GraphLocation As Integer
       Dim XelementsC As Integer, Yelements As Integer

       Dim myChtObj As ChartObject
       Dim rngChtData As Range
       Dim rngChtXVal As Range
       Dim i As Integer


       Dim WSD As Worksheet
       Set WSD = Worksheets(2)     'Data source

       Dim CSD As Worksheet
       Set CSD = Worksheets(3)     'ChartOutput

       'Dim chrt As ChartObject
       'Dim cw As Long
       'Dim rh As Long

       ' get the current charts so proper overwriting can happen Dim chtObjs As ChartObjects
       Set chtObjs = CSD.ChartObjects
       WSD.AutoFilterMode = False       ' Turn off autofilter mode
       'Dim finalRow As Long            ' Find the last row with data
       'finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row


       FirstRow = RowResistiveC
       FirstColumn = 5

       XelementsC = countXelementsC(FirstRow - 1, FirstColumn)                  'Count the x         Elements (amperes)
       Yelements = countYelements(FirstRow)                                      'Count the y Elements (Combinations)

       LastRow = FirstRow + Yelements - 1                                      'The last row and column I will read
       LastColumn = FirstColumn + XelementsC - 1

       '---------------------DRAW THE GRAPHIC----------------------------------------------'

       ' Delete any previous existing chart
        'Dim chtObj As ChartObject

       ' define the x axis values
       WSD.Activate
       Set rngChtXVal = WSD.Range(Cells(FirstRow - 1, FirstColumn), Cells(FirstRow - 1, LastColumn))

       ' add the chart
          Charts.Add

          With ActiveChart
          ' make a XY chart
             .ChartType = xlXYScatterLines
             ' remove extra series
             Do Until .SeriesCollection.Count = 0
                .SeriesCollection(1).Delete
             Loop

             .Location Where:=xlLocationAsObject, Name:="Estimation Sheets"
          End With

          '-----------------------------------------------------------------------------
          With ActiveChart
             .HasTitle = True
             .ChartTitle.Characters.Text = "Factor C"

             'To Interpolate between the ungiven values
             .DisplayBlanksAs = xlInterpolated


              'TITLE STYLE
             .ChartTitle.AutoScaleFont = False
             With .ChartTitle.Font
                .Name = "Calibri"
                .FontStyle = "Bold"
                .Size = 14
                .Strikethrough = False
                        .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .Background = xlAutomatic
             End With

             'AXIS STYLE-----------------------------------------------------------------------

             .Axes(xlCategory).TickLabels.AutoScaleFont = False
             With .Axes(xlCategory).TickLabels.Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 10
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .Background = xlAutomatic
             With Selection.Border
                .ColorIndex = 15
                .LineStyle = xlContinuous
            End With


             End With
             .Axes(xlValue).TickLabels.AutoScaleFont = False
             With .Axes(xlValue).TickLabels.Font
                .Name = "Calibri"
                .FontStyle = "Regular"
                .Size = 8
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .Background = xlAutomatic
             End With

          End With
          '-----------------------------------------------------------------------------
          ' HEIGHT; WIDTH AND POSITION

          GraphLocation = CSD.Cells(Rows.Count, 2).End(xlUp).Row + 3

          Dim RngToCover As Range
          Set RngToCover = ActiveSheet.Range(Cells(GraphLocation, 2), Cells(GraphLocation + 20, 11))
          With ActiveChart.Parent
             .Height = RngToCover.Height ' resize
             .Width = RngToCover.Width   ' resize
             .Top = RngToCover.Top       ' reposition
             .Left = RngToCover.Left     ' reposition
          End With

       ' for each row in the sheet
       For i = FirstRow To LastRow
          Dim chartName As String
          ' define chart data range for the row (record)
           Set rngChtData = WSD.Range(WSD.Cells(i, FirstColumn), WSD.Cells(i, LastColumn))

          'To get the serie name that I´m going to add to the graph
          Dim serieName As String
          Dim varItemName As Variant
          WSD.Activate
          varItemName = WSD.Range(Cells(i, 1), Cells(i, 4))
          serieName = CStr(varItemName(1, 1) + " " + varItemName(1, 2) + " " + varItemName(1, 3) + " " + varItemName(1, 4))

          ' add series from selected range, column by column

             CSD.ChartObjects.Select


            With ActiveChart
                With .SeriesCollection.NewSeries
                .Values = rngChtData
                .XValues = rngChtXVal
                .Name = serieName
            End With
            End With

        Next i

         'We let as last view the page with all the info
         CSD.Select


    End Sub

我从其他人那里打电话给这个Sub。下一步将为其他类型的表和图形调用一个类似的方法(完全相同但是另一个起点来获取数据和一些不同的格式属性):

    Public Sub printGraphics()

       Modul4.ClearGraphs

       Modul4.generateGraphicsC (RowResistiveC)

       Modul4.generateGraphicsT (RowResistiveT)

    End Sub

等等。 CountXelements和Yelements计算表Sheet和RowResistiveC中的元素数量,例如,保持表的位置。

GenerateGraphicsC可以工作,但生成图形T(完全相同)粉碎线:

With .SeriesCollection.NewSeries

Whit错误91(我在工作时使用了德语版的excel,但它不像变量对象或bloque对象那样)。

1 个答案:

答案 0 :(得分:0)

我怀疑错误来自:

CSD.ChartObjects.Select

这适用于第一张图的解决方案,因为我在工作表上选择了单个图形,但是当我添加更多图形时,它没有。

我刚刚更改了该行:

CSD.ChartObjects(1).Activate

等等。它完美地运作。我还必须做出一些调整,以避免所有图形都被绘制在前一个图形上,但它的效果很好。