2013-03-25 35 views
0

我正在編寫一個Excel表格應用程序,它從表格工作表(它也被編程並且每個表格的長度和位置可以更改)中獲取信息,併爲其他工作表中的每個表格生成圖形,當按下按鈕時,稱爲估算表。自動繪製來自不同工作表的圖表

我設法爲第一個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計算表格和RowResistiveC中元素的數量,例如,保留表格的位置。

GenerateGraphicsC工作,但generateGraphicsT(完全相同)在該行美眉:

With .SeriesCollection.NewSeries

白衣錯誤91(我的excel工作德語版本,但它像變量對象或BLOQUE對象不給出)。

+0

我敢肯定的是,錯誤來自這裏: CSD.ChartObjects.Select 我認爲,第一次是OK的,因爲只有一個對象,但第二次,我不指定我正在選擇圖表。 我做了一個測試,添加第二個圖,但沒有添加第一個,它工作正常。 我該如何解決這個問題?我嘗試替換該句子:.ChartObjects(1).Chart 但它不起作用! – Ger 2013-03-26 09:14:20

回答

0

正如我懷疑誤差來自:

CSD.ChartObjects.Select

因爲我選擇薄片上單個圖形第一個圖形在我的解決方案,它的工作原理,但是當我添加更多的它doesn'噸。

我只是改變了這行:

CSD.ChartObjects(1).Activate

等。它完美的作品。我也不得不做一些調整,以避免所有的圖被繪製在前一個圖上,但它很好。